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Introduction 

As  part  of  a continuing  search  for  the  ideal  architecture  for 
performing  the  computations  required  to  realize  a non-linear  filter,  we 
have  developed  software  for  various  machines  over  the  past  ten  years.  A 
description  of  the  latest  software  is  given  in  [l]  , while  [2]  , [3]  . 

and  [4]  are  useful  for  background  information  on  the  non-linear  filter- 
ing problem  as  well  as  comments  about  software  efficiencies  relevant  to 
various  machines. 

We  started  our  studies  over  10  years  ago  using  the  CDC  6600  at  the 
Aerospace  Corporation  and  Kirkland  AFB,  and  continuing  at  Eglin  AFB,  see 
. At  the  Institute  for  Advanced  Computation,  we  gained  access  to 
the  I Iliac  IV  and  at  ICASE,  Nasa  Langley  , the  Star  100,  see  [2]  . Access 
to  the  Cray  was  obtained  through  Cray  Research  and  later  at  NCAR.  Exper- 
iments on  the  AP120B  array  processor  were  possible  because  of  the  acquisition 
of  one  here  at  USC  used  in  conjunction  with  a POP  11-55. 

The  purpose  of  this  report  is  to  document  the  current  software,  for 
all  these  machines.  In  particular,  we  have  found  [2}  , with  the  listings 
of  the  6600  and  Star  Codes,  extremely  useful  In  the  past,  although  now 
these  listings  are  outdated.  In  particular,  the  assembly  language  coding 
for  the  AP-120B  involved  extensive  effort  over  a long  time  period  and 


should  be  documented  so  that  others  interested  in  similar  problems,  can 
avoid  the  pain  of  developing  the  software  from  scratch. 


I PHASE  DEMODULATION 


1-1  CDC  6600  Code 

The  code  shown  in  the  following  pages  evolved  through  a number  of 
changes.  It  was  most  effected  by  the  coding  of  the  Star  given  in  the  next 
section.  The  philosophy  was;  carry  the  two-dimensional  density  as  a single 
vector  of  array  columns  and  break  up  the  computation  into  a large  number 
of  loops  each  small  enough  so  that  at  least  inner  loops  fit  into  the  stack. 
Using  the  CDC  FTN  Compiler  Opt  = 2,  level  1*10  operating  system  this  code 
achieves  .63  megaflops. 
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A.  TWO-DIMENSIONAL  CDC-6600  PROGRAM 


C <BL'CY>SrAF.  FOR;  1 4-NOV-76  10:01:44  EDIT  BY  BOCY 

PROGRAM  CYCLIC  ( IMPUT=  1 29,OU7PUT=  129 ,TAPE5=I NPUT  , 7 APE6=OUT  PUT) 
DESCRIPTION  OF  INPUT  PARAMETERS 


Y 1 F.5T , Y2  FST  - THE  EXPECTED  VALOE  OF  INITIAL  POSITION 
ALP110  - STEADY  STATE  ERROR  VARIAUCE  IN  DECIBELS  * 

DSLF  - THE  RATIO  OF  DELTA  TO  FILTER  TIME  CONSTANT 
022C  - THE  CONTINUOUS  DRIVING  VARIANCE 

N0X1,MUM2  - ARE  USED  IN  CYCLIC  AND  PROBE  CNLY  AND  COUNT  T 
NUMBER  OP  PARTITION  POINTS  IN  RECTANGULAR  CRT 
N02  - THE  TOTAL  NUMBER  OF  POINTS  (ESTIMATES)  IK  EACH  SAM? 


DESCRIPTION  OF  DATA  SET 

DATA  HOST  BE  PUNCHED  IN  THE  FOLLOWING  ORDER: 
yiZSr,Y2E57r  ALP1 10 , DELF,Q2ZC,  NU  M 1 , NC.M  2 , N02 


ALL  REAL  PARAMETERS  (Y1ES?  THRU  Q2 2C)  HAVE  A 10  SPACE  FIE 
ALL  IN7EGEF  PARAMETERS  (SUM  1 THRU  N02)  HAVE  A 5 SPACE  FIE 
AND  MUST  BE  RIGHT  JUSTIFIED  IN  THI ER  RESPECTIVE  FIELDS. 


COMMENTS 


TKF.  MAIN  FLOW  THROUGH  THE  PROG? A J!  IS  GOVERNED  PY  ROUST. 
KOfJNT  COUNTS  THE  POINTS  IS  EACH  PATH.  A BLOCS  TS  A SECTI 
OF  7 Mr.  PROGRAM  THAT  HAS  KO  TRANSFER  15*  OR  OUT  EXC F.?7 
THROUGH  COMMOK. 


*£**«:**•*  **> 


V TA-  i liri 

COMMON  3 (2,  2)  ,P2AR  (2,2)  ,PN  (2,2)  ,AS  (2)  ,F  (2,2)  ,PDU:1Y  (2,2)  , 
♦?DUMY2(2, 2)  , PSF  (2,2) 

LOGICAL  LOW, UP 

CCFSOS  /?S/  »:ZZZ(3),  XHZ  (2) 

• COMMON  /ON/  DZ7.21,  JGAUSS,  XZZ2(2) 

COMMON  / P RO 3/  P 12  , P I , ALT  1 1 0,  DELF,  Q22C , Y 1 EST  , Y2F.57  , 

1 A 11,A22, CONST,  DELT, FTC, PIDLT , P1 10 , 3 1 1 , RX , QD,  322 
******»•»»***»»•***  + «.***  + + * START  BLOCK  1 *****♦*♦♦••• 

2 COHTTKUF. 


JGANSS=0 
Y 1KSV0. P 
Y2EST-0. 0 
A I. P 1 10--  3.  00 

Hr!  F 0.  1 

;-?;?c«o.oi 

t • n 

NH'*?^127 
N02  - 1 .10 
1103  1 

T F ("OF  (r»)  ) 2200, r» 
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PHASE  VARIABLES 
DO  210  1=1,32 

SIGMA  (I)=PI*  ( (2.*I-1.)/32.-1.) 
COSY  ( T)  =C0S  (SIGMA  (I)  ) 

SIHY  (TJ  =STM  (SIGMA  (I)  ) 

SI  (T)  =COSY  (I)/RDEL 
2 10  S 2 ( T ) = SINY  (IJ/RDEL 

n*. a 5; i:  rate  variables 
DO  220  1=1,129 

220  PST  (T)=PIDEL*((2.*I-1.)  /12R.-1.) 
SETUP  THE  TRANSFER  MATRIX 
DO  240  J» 1,120 
J1  = (.1-1)  *32 
J2-  (J-1)  *33 
DO  230  1=1,32 

11  = *11  ♦ 1 ♦ M OD  (4*S-  (J-1)  /4  *-1,32) 

1 2=>T  2*1 

230  JNS  ( T 2J  =11 

240  JNS  (J2*33)  =JNS  (»T2 ♦ 1 ) 

SETUP  THE  INTERPOLATION’  VECTOR 
IN  (1)  =0.079 
TN  (2)  =0.629 
I N (3)  =0. 3 79 
IN  (4) =0.  129 
IN  (9)  =IN  (1) 

IH(f)  =IH  (2) 

I N ( 7)  =T  N (3) 

TN  (3)  =TN  (4) 

.l  = MOD(!:TERM,4) 

07  249  1=1,4 
249  DEL  I (D  = T V ( I ) 


•>,i  ir-i 


T = 9,  129,4 


D3L.1  (T)  --0EL.T  (1-4) 

P9L.1  ( I 1 ) =DLLJ  (1-3) 

DEI  .1  (1*7)  =DE:..T  (1-2) 

*90  PILJ  ( I «■  3>  = OELJ  (1-1) 

LVAIUATE  CONVOLUTION  T.EFMS  A (I ) 

PO  292  1 = 1 , HTtTJl 
‘ T ; MP= 1/ 1 23. 

T FF  P=CON  ST*7SM  P*TEf*  P 
A (I)  O. 

Tr  ('ZNP.GT. -47)  A (T)  =EXP  (TEP  R) 

!3"  continue 

c:s  strict  t:ie  a priori  density 

C NO- Y= 1 . 0/ (TVOPI *S0ST { A 1 1 *A 22)  ) 

CL=-'> . 9/A22 

ST  = - “ . 9/ A 1 1 

OP  2a7  1=1,32 

C?=  3 IGNA  (I)  - Y 1 EST 

cr  -•'I5  *C?*SI 

JV-O 

02  ?10  J=1,  123 
J 2-  il*I 

Tc.-P  -PSI  (0)  -Y?F.ST 

JC  : ?: ) ~ZA?  (TEtf  P*TE.3  P*CL  ♦ C?)  •CNr-P'*. 
or  j i--.i  i * J2 
•JIT  .'RN 
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J 1=HSI7.E32 
J2= J 1 

DO  30  1=1, HTE3M 
J 1=  J 1 * 32 
J2=J2-3:» 

TEMP=  A ( I) 

PC  fO  .1  = 1,4096 
K l=J1M 
K2= J2 

no  JN  (J)  = J N (J)  ♦■TEfl  P*  (JNA(KI)  *JNA  (K  2)  ) 

CUMULATE  ROW  SUMS 
no  *10  1=1,32 
11=1 

TENP2=.1N  ( T 1 } 

DO  70  .1=1,127 
11=11 ♦32 

70  TEii?2=TE«P2  + JN  (II) 

PC  TPOW  (T)  = TEKP2 

ACCUMULATE  ESTIMATES  AND  NORMALIZATION  CONSTANT 
CNCSK=TFTW(1)  •SSI  (1) 

SHAT=STSr  (1)  ♦CKOPM 
C HAT=COS Y (1)  *CN09M 
20  35  1=2,32 
7JKP2="*50W  (T)  *SM1  (I)  " 

SHA7=  SKATES  1ST  (I)  *TEHP2 
CHA?=CHAT»COSY  (I)  *TEM?7 
35  C V0RM=CS0R!1  ♦TEN  P2 
C Nn  ?.vi  = 1 . O/CN 
??*?.?=  SHAT*CSOn  ,v. 

C::AT=CHA?*CS03M 
TRANSIT?  NORMALIZED  PZNSIT7 
PC  °C  1=1,32 
11  = 1 

7rr.P2=s:Ji  (T > *rsu?.r 

no  RC  j = i , 1 2s 

J'.  (T  1 ) =T  SM?2* J S (T  1) 

9?  11=11*32 


T SL  F = SECOND  (*"T)  -7 
Fi'T  URN 

I SI  TI  ALT?. E SAYPLE  PATH  dy  teansfertss  JO  to  .in 
IOC  IF  ( VC. LE .O)  GC  TO  200 
DC  110  1=1,4096 
1 1C  J*-  (I)  =.1  0(1) 

;•  ETU?  \ 

GIDPAI  INITIALIZATIONS  FOR  NONLINEAR  TIL" FT 
200  NT.IZE=10 

FTFP.1  =f  4 . 0*5iJ?T  (50.  *Q22)  /PTDEL*0 . r: 

IF  (ETE-M.Cr.llSIZF.)  N",E3M=r:SIZE 
SSTZF32=Nr»IZE*32 
NTE?r.32  = STE?M*32 
NK2  = ;:SIZF.32«-1 
NJ1=SK2-N?S?M32 
NJ2  = S SI ZS32*  4097-MT  FPN  3? 

Ml  = » SI7.i32*4''97 


s 
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SUBROUTINE  HLF  (MC, S Art  P,  Z 1 , Z2  , S H AT,  CHAT , TMI.FJ 

INTEGER  HC,  SAMP 

REAL  7. 1 ,Z2,  SHAT, CHAT, TU LF 

INTEGER  1,11, JC,J1  , J2,K1 ,K2 ,KL,KH,  NJ1  f N J2  , K K 1 , NK2  , >.T  ERM, 

1 NTERM32,NSI7.  E,NSIZE32 

PEAL  A 1 1,  A22,  CL,  CHOP .1,00 VST,  CP,  PI , PIDEL  ,Q22  . SI , 7,  T7  , 

1 Y1FST,Y2EST, TEMP, TEMPI, TEMP2 

PI  AT.  IN  (3) 

PEAL  TROW  (32) 

REAL  COSY  (32)  ,SINY  (32)  , SHI  (32)  , S 1 (32)  , S2  (32)  r SIGN  A ( 32) 
REAL  P3I  (128)  ,A  (10)  ,DELJ  (123) 

INTEGER  JNS  (4224) 

REAL  JN  (4096)  , JK1  (4  096)  , JO  (4095)  ,JNA  (4756) 

COMMON  /PRO B/  TROPI, PI, ALP1 10 , DELF, Q22C, Y 1 EST,Y2 E5T  , 

1 All, A22r CONST, DEL, FTC, PIDEL, P 1 10 ,BDEL, R X , QQ , Q2 2 

COMMON  /HLFC/  NC, NT, NTERM, NTERH 3 3,S 1 ,S2 ,S IG.NA , ?3I , A,  COSY  , 
1 DELJ , JO, JNA, JNS, SIHY 

EQUIVALENCE  (JH1  (1)  , JMA  (321)  ) 

IF  (SAMP.LE.O)  GO  TO  100 
SET  CLOCK 
T=  SECOND  (T) 

EVALUATE  SEN SOP  7EFM5 
TO  10  1=1,32 

1C  SN1  (I)  = EX?(Z1*S1  (I)  +Z2*S2(I)  ) 

FC7M  THE  INTERPOLATED  .7N  AND  rUT  IB  JN 1 

J1=0 

J2=0 

DO  30  T= 1 , 1 28 
TEMP=I)ELJ  (I) 

DO  20  J=1,  32 
x 1= j i 

KL=JN3(K1) 

X H = J N S (K 1 *1 ) 

TEMPI  = JH  (KL) 

K 2=J2*  7 

TO  j ji  \ (K2)  =TEMP1  ♦TEMP*  (JS  (KH)  -TEMP  1) 

J 1 = J 1 ♦ 3 3 
?C  .1 2" J2 ♦ 12 

EXPAND  INTERPOLATED  MATRIX  ON  BOTH  SIDES 

J 1 = NJ  1 

J2-JU2 

v 1 - N K 1 

K2=VK2 

DO  40  1=  1 ,vter:-*32 
JNA  (JI)  = JMA  (J 2) 

JN.A  (K  1)  = 1NA  (X?) 

J 1 = J 1 ♦ 1 
J 2= J 2 ♦ 1 
K 1 = K 1 ♦ 1 
4 0 7.  2=K2  ♦ 1 

CONVOLUTION 
DO  50  1=1,4096 
J = I ♦NSrZr:32 
")  JN  (T)  - JMA  (J) 


™ 1 ,S  P4G*  15  BSS1  QUALITY  PRAOTKUAUV 
Y *Wl.Umj  xobdq  * 
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SUDH0W7I  N E GAUSS  ( JS,  30,  XM  ,X) 
DIMENSION  NST  (2) 

COflflON  /RN/  Nl,  N 2,  MC,  Tl,  T2 
COMMON  /r.  11/  TWOPI,  J.  XR  (2) 

TF  (J)  10,  10,  20 

10  .1  = 2 

TVOP1-0.  MTAN  (1  .} 

NST  (1) - 1 02043 
NST (?) = 1956 17 
XR  ( 1 ) = 3A  NF  (NST  , 1) 

GO  -0  35 

20  GO  TO  (30,40) , J 
30  .1  = 2 

XR  (1)  =0ANF  (NST , 0) 

35  XR(2)  =0 ANF (NST,  0) 

X1=S«R7  (AflS  (-2.  *ALOG  (XR  (1)  ) ) ) 
XR  (2)  =TXOPT*XR  (2) 

XR  (1)  =X1  *SIN  (XR  (2)  ) 

XR  (2)  =X1*C0S  (XR  (2)  ) 

x=x  r (i)  *sd*xm 

RETURN 
4 0 .1=1 

x=x?  (2)  ♦SDor.r 

PETUPN 

FND 


FIIXC7I1M  HA  NT  (NS,  MOPE) 

DIMENSION  f.'5(2),  NC  (2) 

COMMON  /6N/  Hi,  N2,  MP,  Tl , T2 
DATA  K1,  M2/?44-»34,  153551/ 

MODE=0  TO  CONTINUE,  OTiiffU’TSS  PESTA 
INTEGER  MUX  HEP  NS  (1)  *2**  13  ►NS  (?) 

IF  (MODE)  10,  100,  10 
10  N 1 = NS  ( 1 ) 

N2=N*S  (2) 

71=?.  ♦♦(-1H) 

7 2=2.  **  (-3:'») 

MP=?**1  9 

100  PO  200  1=1,2 

GO  TO.  (110,120)  ,1 
110  K=X2*N2 

CO  TO  100 

120  K =:1 1 * N 2 » M 2 * N 1 ♦ X P 
1°0  KP=K/M? 

20P  SC  (I)  =F-KP*XP 
N 1=  NC  (?) 

K2=*‘C  (1) 

X V 1 = N 1 
v S 2 = l!  2 

r x:«  1 *T  1 ♦XS2*T? 


H=N 02-30 
SOM  P=SUH  P/H 
SU«C= SUMC/H 
XNSA  NP=NSAHP 
XAA^XNSAMPM.O 

SUMP1 - (SUMPi-XN  SAMP*  SUMP  1)  /X’  ft 
DSUMPl  = AL*y;lO  ( S U M ? 1 ) *10. 

WPTTr  (6,  1509) 

1508  FCRMAT(*0*,5X,*NON LINEAR  CYCLIC  ESTIMATOR  *) 

WRITE  (6,1511)SUMF1,DSU‘1P1 

1511  FOPf1A7(*0*,*AVERAGE  STATISTICAL  VARIANCE  = *,l?E13-6,  10X, 

* ♦AVEPAGE  COMPUTED  VARIANCE  = *,  1 PF.1  3. 6//) 

SUM  P = Q. 0 
SU!1C=0.9 

DO  1601  1=31, K02 

XD  = ASS  (XDAT  (r,1)-XCAT (1,4)  ) 

1693  CONTINUE 

IF(XO.  GT.  PI)  GO  TO  16  99 
GO  TO  1700 
!699  XD=XD-?I2 
GO  TO  1693 

1790  SUM  F= { X D) * *2 ♦SU M3 

S U 1 C=  X D AT  (1,5)  *5 U «1  C 
If  Cl  CONTINUE 

SUM P=  S'J"  ?/H  x 

Sli:iC=SU  MC/H 

SUMP2=  ( S U M P X N S A M ? * 5 U M ? 2 ) /X  A A 
DSUMP2= ALOG 1 0 (SUMP2) *19. 

WRITE  (6,  1509) 

FO?  M AT  ( * 0 * , 5 X , + ? E-  M N - .*•  7 IE  ED  K-3  FII’E?') 

WRITE  (5,1511)  SUM  P2 , PS’IM  ?2 
.\SAr:P=!i5A:iP»  1 

IF  (ISAM?.  EO.  H03)  GO  TO  2200 

ISA'tr=ISAM?«-l 

CC  TO  11 

****  <i  ***********************  * £ND  BLOCi:  1 **************  ******* 

■209  W*T?r  (6, 2201) 

■? 31  rc?.'r~  ( * 0*  , 4 0>.  , * \Mp  *iJL  COMPLETION*) 

STOP 

END 


QU*&Il+ 
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08  X 1FF=  X 1 FP-PT2 
GO  TO  34 

09  X1FF=X1FF*PI2 
GO  TO  04 

90  con t me 

IF  (AOS  (CKHAT)  .GT.  XLTH) LIH NL= LIrtOt M 
IF  (Ann  (X  1 FF)  .GT.XLIR)  LlHKB  = LIHKB*- 1 

*•**•*•*♦***************♦  PP^DICTOI.  update  ***♦*♦*♦*■***• 
XHAT1--XIIAT  (1)  ♦ r>ELT*XH  AT  (2) 

XHAT2=XHAT  (2) 

XDAT  (KOUHTr  4) =XHAT(1) 

XCAT  ((COUNT, 5)  = PNF  (1r1) 

xirod*x1 

184  CONTI  HOE 

IF(XIKOD.GT.PI)  GO  TO  188 
IF  (X1HOD.LT. -PI)  GO  TO  189 
GO  TO  190 

189  X 1HOD=X  1.1QD-PI 2 
GO  TO  184 

189  X1K0D=X1R0D*?I2 
GO  TO  194 
V*”)  CONTINUE 
I KHS  I.P=0  . 

X 1F2=  ABS (XHA7  (1)-X1 j 
31°  I F (X  1 F2  . GT.  PI)  Cl  TO  340 
GC  TO  341 
340  CONTINUE 

X1F2=X1F2-PI2 
IKBStP  = ikdslpm 

90  TO  3.3  9 
3 al  CONTINUE 

EP9Lr  = A BS (XI FF-X1H3D) 

ERFNL=A3S  (CXHAT-X  1*00) 

IF(EPPLF.GT.PI)  EPPI.F  = A95  (EP.RIF  -PI 2) 

I F (ErRN’L.  GT.  PI)  En3f'L  = AUO  (EH3NL-PJ2) 

F.HROF=ADS  (X  1.XOD-CXKA  I) 

K2IT  (ft  # 201)  *<0UNT#  XDAT  (K0GN7, 1)  , XI  HOD, XDAT  (*Ci!NT,  2)  ,21,72, 
♦ (KCIINT, I)  ,1  = 3,9) 

>31  F03HAT(*f>*,  13,  IX,  1P3El4.ft,4X,  1?2E  1 4.9 ,4M,  1?  3E  1 4 . ft  /) 

I r (KCMJTT.2C- N02)  GO  TO  505 
KOUN7=KOUNT  1 
GO  TO  450 
5P5  CONTINUE 
SUf*P=0.  0 

SUHC=0. 0 ,vj1 

DO  1501  1 = 31,  S02 

XD3ABS  (XDAT  (1,1)  -XCAT  (1,2)  ) "" 


(X  DAT 


205 


DEV  3=  SQRT(RII) 

CALL  GAUSS  (JSEPD,  DEV  t , T 1 EST  , X 1} 

K0UNT=1 

XUAT  (KOUNT,  1)^X1 

C AI.I.  GAUSS  (JSEED,DEV2,  Y2EST,  X 2) 

CALL  GAUSS (JS E ED, DEV 3, COS { X 1 ) ,Z1) 

CALL  GAUSS  ( JS  FED  , DEV  3 , S I U ( X 1)  , Z2) 

PEVQ2-  SJ?T(Q2?) 

n=r.  n 

l/ETTE  (6,  1509) 

FO?” AT ( *9  * , 3X , * FOSIT . * , 5 X , *POS IT.  MOD  2 ?I*,2X,*ZST.  ?DSIT.*,9X, 
**7l  AMD  7.2*,  1?X,  *CYCLIC  LOSS*,5X,*  K-B  EST.  AND  P 11  *) 

GO  rO  070 


END  BLOCK  1 
START  BLOCK  2 


050  CONTINUE 


X1  = X1  *■  X 2 * D E L ? 

XDAT  (FOUNT,  1)3X1 

CALL  GAUSS(JSF.ED,DFVg2,  X2,X2) 

CALL  GAUSS  (JS  E EG,  DEV  3 , COS  (XI)  , Z 1) 

CAII  GAUSS  (JSESD,D2V3, Sill  (XI)  ,Z2) 

***********************  RICCATI  EQUATION  UPDATE  **********,**,*, 
PDUMY  (1  , 1)  = (P*  (PM  (1 , 1)  *2.0*PW  ( 1,2)  *D£LTJ  -PN  (1,2)  **2» CZ1SQ)  *D3M 
* * PH  (2, 2)  *DELSQ 

PPUKY  (1,  2)  =PN  (1,2)  * (R-PN  (1,2)  * D ELT)  *DSK  * PN  (2,2)  "*D2LT 
P Dll  BY  (2,2)  = -rH  (1,2)  * *2*  DEN  I»  >1  (2,2)  ♦ Q(2,2) 

P*1  (1,  1)  =pdu;:y  (1 , 1) 

PH  ( 1 , 2)  =PDnMY  (1 ,2) 

PN  { 2 r 2J 3 P DO !1  Y (2,2) 

?N(2,1J=PN(l,->) 

DEN  =■  1.0/  (PN*  (1,1)  ♦ P) 

****************************  LHD  BLOC?-  2 ♦*♦**•*  •»•*♦»***»*♦  ^•♦**» 

**************  * ********  * **  * STAPT  BLOCK  3 • •»■*••*•*»*******##**, 


0 7''  CONTINUE 

CALL  NLF  (1,  1,21,22,  SHAT  , CHAT , T.’ILF) 

•/rite  (6,5697)  tklf 

5i:77  FOPY A7(r 10.5) 

C !!  ft  I = ATAM2  ( SHAT, CHAT) 

367  PL03S -2. 0*  ( 1.0  -SQRT  (SKA'"**2*CHAT**2)  ) 

X DAT ( XOU  NT , 2) =C  X H AT 
X DA  T (*fOUSr,3)  = PLOSS 
PM?  ( 1 , 1 ) = ?{»{  1 , 1 ) *9*DEK 
?NF(1,2)=PN  (1,2)  *2*  PEN 
FHF  (2,1)  = PE F (1,2) 

PHr  (2,2)  =PH  (2,  2)  - PH  (1 ,2)  ** 2* DEH 

****************************  FILTER  UPDATE  ********************= 

SINFl=SI W (XHAT1 ) 

cose i-cos  (>:ha~  1) 

XUAT  (1)  =XIIAT1  H)E?I*  (-PN  (1,  1)  *SIHP1*ZUPN  (1,1)  *C CSF  7 *22) 

XUAT  (?)  “ XUAT?  *,!)F.M*  (-P1!  ( 1 , 2)  *SINr1*7.1»PU  (l,2)*COSF1»Z2) 

X 1 F r = X U A T (1) 

.30  C(W  riNUE 

I r (X  1 FP.GT. PT ) GO  TO  US 
IF  (V  1 FT.  LT. -PI ) 50  T 3 99 
rc  TO  90 


THIS  PAOI  IS  BEST  QUALITY  FKAGXi£fctfM 

raou  copt  —mil  so  coo  


10 


5 CONTINUE 

WRIT  E (6,65  1)  Y 1 EST, Y2EST  , ALP  1 10  r DRLF,  Q22C  , Hilt  1 ,*««»?, »I02 
651  FORM  AT  (*  *,*  CYCLIC  INPUT*, 4X,5P10.5, 315) 

P110=1P.**  (ALP1 10/1  0.) 

Q3=0?2C**(.25) 

NX  = (PI  10/(5QR7  (2.0)  +QQ)  ) **{4. 0/3-0) 

F7C=SC>RT  (2.0)*  RX**  ( .25)  /QQ 
DKI.T=PRI.F*FTC 
Q22=p?2C*DELT 
P 1 1 = HX/DELT 

P220*P1 10*S33T  (Q22C/RX) 

13  Ml  P=  1 
N5ANP=0 
3IIHP1-0.0 
3US1P2=0.0 


CONTINUE 

A11  = 19.**((ALrl10*1-4)/10.) 

A 22=  P220 

K0DN7-1 

DELSQ=DELT**2 

Pl=  3.  1415926536 

PI?=2 .0*PI 

PIDL7-PI/0&LT 

CON5T=-2.')*PIDLT*?TDLT/322 

?INV=1.0/?I 

PI2DLT=2.0*PIDL7 

Ul  = NUKl 

U2=i::;r?2 

XM  " = . 75*PI 

LIHNL=0 

LI.V.K3  = 9 


3P,  D=0.0 
3(2,21=022 

A=DELT*PI»'/*SO:<T(  10.0*tf22) 
I A=  A *0. 5 


I Y?=,?2/PI2PLT*3Q3T  (53 .0*02-2)  ♦ .5 
CALL  NLF(0,C,21,Z2,r,!1AT,C:1AT,TNLF) 
11  CALL  KLF  (1,0,1  1,Z2, SHAT, C!IAT,TNLF) 

>:  ha  r (i)  = y i r s 7 

XKAT  (2)  *Y2r.ST 
X HAT  1 =Y 1 RST 
t:;AT2=Y2E37 


rS(1,  1)  “All 
FN  (2, 2)  =.A22 
?N(1,7)  =0. 

FN  (2,  1)  =0. 

9 = 311 

D5V  1 = SOHT(MI) 

PEN  = 1 . 0 / ( ?.*!  (1  , 1 ) ♦ R) 
F / 1 , 1 ) =1-0 
F (1,7) =DELT 
F (2,  1) =0. 

F (2,  2)  =1.0 
OEV 2=  5QRT  (A22) 


ii 


I - 2 Star  100  Code 


! 


This  code  was  developed  by  keeping  in  mind  that  Star  is  efficient 
on  long  vectors  and  has  a large  memory  bandwidth,  consequently  the  density 
was  carried  as  a long  vector  with  extra  elements  carried  in  the  vector  to 
eliminate  the  need  for  modular  arithmetic.  All  operations  were  viewed  as 
column  oriented  and  assembly  listing  with  loop  timing  were  used  to  iteratively 
improve  the  code.  Star  Fortran  is  standard  Fortran  with  added  vector  in- 
structions such  as  VGATHER,  VSUM,etc.  The  CDC  Star  Fortran  manual  will 
be  helpful  in  understanding  the  resulting  code.  Writing  this  code  and 
tailoring  it  to  the  Star  strengths  provided  much  insight  into  our  problem 
and  produced  significant  improvements  on  code  for  the  other  machines.  In 
particular  it  is  strange  that  coding  for  the  llliac  had  little  fallout 


for  other  machine  coding.  The  code  achieved  16  megaflops. 
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00003 

00009 

00005 


00006 

00007 

00008 

00009 

00010 
00011 

00012 

00013 

00019 

00015 


.2  CYCLE  115P2  0-B  SOURCE  LISTING 

PROGRAM  MA IN (INPUT* OUTPUT* TAP E5- INPUT* T A? E6-0UTPUT) 

SAMPLt  PATH  VARIABLES 

RtAL  SX1(130),SCHAT(130)»SSHAT(130),Sa1HATNL(130),SERRNL(130), 

1 TNLF(130)»SPL0SSNL(130)»SXlHATPL(130)»ScRRPL(130)»SPllPL(130) 
CUMULATIVE  SAMPLE  PATH  VARIABLES 

REAL  CERRNL(130)»CESQNL(130)»CEVARNL(130I , CD6NL < 1 30 ) , CCSNL < 130) 
REAL  C ERR PL (130) ,CESQPL(  130)»CEVARPL  ( 13G) ,CDBPH 130) ,CCSPL( 130) 
MONTE  CARLO  SUMMARY  STATISTICS 
REAL  XERRNL .XESONL  ,XEVARNL,  XOBNL  ,XCSNL , 

1 XERRPL»XESQPL»  XEVARPL, XD8PL,XCSPL 

SINGLE  SAMPLE  VARIABLES 
REAL  CHAT»SHAT,X1HAT»P11»X1»Z1»Z2 
CONSTANTS 

REAL  CS(130),DBEPS,£PS(130),Tri0PI,ZERD(13D),0NE(130),PI2(130) 
FORKING  VARIABLES 
INTEGER  I,J,K,L 
REAL  T»  TEMP { 1 30 ) 

LOGICAL  PATH»CUMPATH 
BIT  B T ( 1 30 ) 

PROBLEM  SETUP  VARIABLES 
REAL  ALP  110, DELE, Q22C,Y1EST,  Y2EST 
INTEGER  NMC  »NSAMP»MD»  UD 
DERIVED  PROBLEM  CONSTANTS 

REAL  All, A22, CONST, UEL»FTC, PI, PI0EL,P110,RDEL,RX»Q3»Q22 
PR03LEM  COMMON 

COMMON  /PROB/  T ROP I , P I , AL P 1 1 0, DE LF , 02 2C , Y 1 E S T , Y2 E ST , A 11 , A22 , 

1 CONST, DEL, FTC, PIDEL,P110,RDEL,RX,3Ci,  C2  2,  MD,ND 


00016 

WRI  TE (6,991 > 

00017 

991 

FORMAT  ( ' FILT2NN,  VERSION  9-22M 

C 

SET  PRINTOUT  CONTROL 

00018 

PATH". TRUE. 

00019 

CUMPATH-.TRUE . 

C 

RE  AO  INPUT  PARAMETERS 

00020 

10 

READ  (5, 5000, END* 500 1 Y1EST,Y2EST,AL?110, Jt L F , Q22C, NMC, NS  AMP, HD 

00021 

5000 

FORMAT (5E1G.9,315 1 

C 

COMPUTE  THE  CONSTANTS 

00022 

MD ■ ( MO/2 ) *2 

00023 

IF  (M0.LT.2O)  MD-32 

C0029 

IF  (M0.GT.69)  MO-32 

00025 

ND-9AM0 

00026 

PI-9.0* AT AN (1.0) 

G0027 

ThOP I -2 . 0*P I 

C0026 

PI 10-10.**( ALP110/10. ) 
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C0029 

00030 

00031 

00032 

00033 
000  39 
0003  5 

00036 

00037 
C003S 
00039 

00090 

00091 

00092 

00093 
00099 

I 

00095 

00096 

00097 
00096 
00099 

00050 

I 

00051 

00052 


00053 

00059 

00055 


Rl.2  CYCLfc  115P2  0*B  SOURCE  LISTING  13.39  HRS. 

00-022C**I.25) 

RX-IP1 10/ (SQRT(2.0)*0J)>**(9. 0/3.0) 

FTC“S0RT(2.0)*RX**( • 2 5 ) / Qu 

DEL»DELF*FTC 

Q22»C22C*DEL 

PIOEL-PI/OEL 

RDEL-RX/DEL 

'AU«lO.O  + *(  (ALP  110  + 1.9)/ 10.) 

,A22“2.0*P110/(FTC+FTC) 

C0NST»-2.O*PIDEL*PIDEL/G22 
C S ( 1 ; 1301-0. 75*?I 
PI2 ( 1 » 130) -TWOPI 
ZERO! 1 )130)-0. 

EPS(l)130)-l.E-50 
DBEPS-AL0G10(EPS< 1) > 

ONE ( 1 j 130 ) ■ 1 . 

INITIALIZE  CUMULATIVE  SAMPLE  PATH  VARIABLES 
CERRNL(l)13C)-0. 

C fc  SON  L ( 1 * 1 3 0 ) ■ 0. 

CCSNL (1)130) -0. 

CERRPL(l)130)-0. 

CESOPL ( 1 ) 130 ) s0. 

CCSPL (1)130-0. 

PRINTOUT  PRU8LEM  PARAMETERS 

WRITE  (6.6000)  NMC.NSAMP, ALP110.DELF.022C » Y 1 E S T . Y 2 E S T , 

1  PI 10»QQ»RX»FTC»DEL.022»PI0EL»R0EL»A11. A22.C0NST.CS  (1) 

6000  FORMAT ( 1H1. 31X.18HPR0BLEM  PARAMETERS/ 

1 1H0, 11X, 9HPARAMETER.6X, 5HVALUE. 11X.9HP AR AMETER, 

2 6X, 5HVALUE/1H0. 19X.3HNMC.9X, I 9. 19X, 5HNSAMP, 8X,  19/ 

3 13X.6HALP110.3X.E15, 6. BX.9HDELF.9X.E15. 8/ 

9 19X.9H022C .9X ,E15.9,8X,5HY1EST,3X,E15.B/ 

5 19X,5HY2EST»3X.E15.B»BX,9HP110.9X,E15.b/ 

6 15X.2H00.5X.E 15.8.9X.2HRX. 5X. El  5. 8/ 

7 1 5 X. 3HFTC»9X»E15.d»9X»3HDEL»  9X.E15.8/ 

6 15X,3HQ22,9X,E15.8»6X,5HPIDEL»3X,Ei5.3/ 

9 19X.9HR0EL.9X.E15. 3, 9X.3HAll.9X, £15.8/ 

A 15X  <.3HA22,9X,E15.8,dX,5HC0NST»  3 X. 6 15. 3/ 

B 15X.2HCS.5X.E15. 6) 

BEGIN  THE  MONTE  CARLO  PROCESS 
INITIALIZATION  OF  THE  SUBROUTINES 
CALL  STATE(0,0,X1,Z1»Z2) 

CALL  NLF(0,0,0.,0.,SHAT,CHAT,T) 

MONTE  CARLO  LOOP 
DO  200  K-l.NMC 

INITIALIZATION  OF  SAMRLfc  PATH  VARIABLES 


31MAY7 


1U 


ii'i&v 
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C0056  CALL  ST ATE  I K, 0 » X 1 , Z 1 » Z2  ) 

00057  CALL  NLF ( K, 0, Zl, Z2, SHAT, CHAT, T ) 

00058  CALL  PLLIK»0,Z1,Z2,X1HAT,P11) 

C SAMPLE  PATH  LOOP 

00059  DO  100  J ■ 1 » NS  AMP 

00060  CALL  STATEIK,J,X1,Z1,Z2) 

00061  CALL  NLF IK,  J,  Z1,Z2, SHAT, CHAT, T ) 

00062  CALL  PLL ( K, J, Zl , Z2, X 1HAT , Pll ) 

C STORE  THE  SAMPLE  VARIABLES 

00063  SX1(J)-X1 

00064  SSHAT  ( Jl-SHAT 

00065  SCHATl j) -CHAT 

00066  TNLFIJ)-T 

00067  SX1HATPL I J )-XlHAT 

00068  100  SP11PL(J)-P11 

C VECTOR  ACCUMULATE  THE  SAMPLE  PATH  AVERAGES 

00069  SX1HATNL 111 130)-VATAN2lSSHATll)130),SCHAT (lj 130); 
l sxihatnl(1;130) ) 

00070  SERRNL ( 1; 130) -SX 1 ( 1 ; 1 30 ) -SX 1HAT NL ( 1 ; 130) 

00071  CALL  M0D2PI (SERRNL) 

00072  SPL JSSNL ( 1; 130) -SSHAT ( 1 ; 130) ♦SSHAT ( 1 ;130 ) *SC HAT 11)130)* 

1 SCHAT ( 1 ; 130 ) 

0007  3 SPL0SSNL(l;130)-2.0*( l.G-VSQRTI  SPLCSSNL (li 130 ) ; SPLOSS NL ( 1 ; 1 30 ) ) ) 

00074  CERRNL(l;130)-VAVG(CERRNLlL;130),SERRNLtl;130),K;CERRNLtl;l30)) 

00075  TEMPI  1;  130-SERRNL  ( 1 j 130)*SERRNL  ( 1;  130  ) 

00076  CESdNL(l;130)-VAVG(CESQNLIl;130),TtMPtl;130),K;CES3NL(l;130)) 

00077  IF  K.LE.l)  GO  TO  110 

00078  CEVARNL(l;l30)-CES0NL ( 1 ; 130 )-C ERRNL (1;  130 > *C ERRNL l 1) 1 30) 

00079  BT(l;l30)-(CEVARNL( l;130).LE.EPS(l;130)  ) 

00080  CEVARNLI 1; 1 30) -OBVMAS* I EPS 1 1 ) 13C > » C EV ARNL 1 1 ) 1 30 ) » BT C 1 ; 1 30 ) ; 

1 CEVARNU  1;  130)  ) 

00081  CD8NL  11)130  )-VALGG10lCEVARNLI  1;  13C  );C0dNU1;  130)  ) 

C0082  CDBNL 1 1 ) 1 30 ) - 10. 0*CDBNLI 1 ) 1 30 ) 

00083  110  BT(l;130)-(SERRNL(l;130).GT.CS(l>130>) 

0008**  TEMP(l;130)-08VMASK{0NE(l;130)>ZERu(l;130)»5T(l;130); 

1 TE  MP ( 1 ; 130  ) ) 

00085  CCSNL ( 1 ) 1 30 ) ■ VA VG ( C C SNL C 1 ) 130), TEMP 1 1 ; 130 ) , K ) CCSNL 1 1 ) 130) ) 

00086  SERRPL(1)130)-SX1(1;130)-SX1HATPL( l;130) 

00087  CALL  M0D2P I ( SERRPL) 

0008 e CERRPUl)130)-VAVGlCERRPLU;130),>ERRPLll;130),K;CtRRPLll;l30>) 

00089  TEMPI  1)130 ) -SERRPL ( 1 ; 1 30 )*SERRPLli) 130) 

00090  CES3PLIl;l30)-VAVGICESQPLIl;l30)*TeH?Il;130)»K)CES3PLll»l30)) 

00091  IF  (K.LE.ll  GU  TO  120 

00092  CEVARPUl;130)-CESOPLIl;130l‘  CERRPL  U|130)*CERRPLU;130) 

00093  bT(l*130)-(CfcVARPL(ljl30).Lc.tPS(l;i30)) 
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00099 

00095 

00096 

00097 
00096 

00099 

00100 
00101 

C 

00102 

00103 

00109 

00105 


00106 

00107 

00108 


00109 

00110 
00111 


00112 
00113 
0011 A 


00115 

00116 
00117 


00118 

00119 

00120 


R1.2 


130 

6010 


6011 


6012 


6013 


6019 


6015 


6016 


00121 

00122 
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CEVARPL(1;130)»Q»VMAS<(EPS(1; 130)»CEVARPL(1;130),3T(1;130); 
CEVARPK  1J 1301) 

CDS  PL (1)130 )»VAL0G1Q(CEVARPL( 1;130) JCDBPL ( 1;13C  ) ) 

COBPL ( li 1301-1 0.0*C08PL  < 1 » 130) 
BT(1;130)-(SERRPL(1;13G).GT.CS(1;130)) 

TEMPI  1)130) -C8VMASK(0NE(1;130)»ZERG(1; 130), dT(l) 130); 

TEMP ( 1; 130 ) ) 

CCS PL <1)130)-VAVG(CCSPL( 1)130),  TEMP (1; 130), K; CCS  PL ( 1)130)  ) 

IF  (PATH. AND. (K.EO.l  ))  GO  TO  130 
GO  TO  200 

PRINT  SAMPLE  PATH  VARIABLES 
WRITE  (6,6010) 

FORMAT ( 1H1, 36X,21HSAMPLE  PATH  VARIABLES/ 

38 X, 19H (FIRST  SAMPLE  PATH)/) 

WRITE  (6,6011) 

FORMAT ( / 1 8 X , 9HSX1-  ,6X, 

36H  PHASE  VARIABLES  / 

20X,1HI,13X,11HSX1(I)  , BX,  13HSXK  I *1  ) /> 

WRITE ( 6,6100) (( I, SX1 ( I ), SXl ( I ,1 )), 1 -1, 129,2  ) 

WRITE  (6,6012) 

FORMAT! /ieX,9HSSHAT-  ,6X, 

36H  SIN(SXl)  ESTIMATES  / 

20X»1HI, 13X,llHSSHAT ( I ) , 8X, 13HSSHAT ( I *1 ) /) 

WRITE(6,6100> ( (I,SSHAT(I>, S$HAT( 1*1 ) ), I-l, 129,2) 

WRITE  (6,6013) 

FORMAT (/18X,9HSCHAT-  ,6X, 

36H  COS(SXl)  ESTIMATES  / 

20X.1HI, 13X,11HSCHAT( I)  ,8X,13HSCHAT  < X ♦! ) /) 

WRITE (6, 6100) ( ( I, SC HAT ( I),$CHAT( 1*1 ) ), I- l, 129,2 ) 

WRITE  (6,6019) 

F0RMAT(/18X,9HSX1HATNL-  ,6X, 

36H  NONLINEAR  ESTIMATES  / 

20X,1H1,13X,11hSX1HATNL(I)  , BX, 1 3H S X 1HAT NL ( I ♦ 1 ) /) 

WRITE (6,6100) ( (I ,SX1HATNL( I ), S X 1HATNL (1*1 ) I , I -1  * l 2 9,  2 ) 

WRITE  (6,6015) 

FORMA T(/16X,9HSERRNL-  »6X, 

36H  NONLINEAR  ERRORS  / 

20X, 1HI,  13X, 11HSERRNL( I ) , 8X, 13HSE RR NL  C I ♦ 1 ) /) 

WRITE  (6,6100)  ( (I,SERRNL  ( I ),  SEP.RNLI  I +1  ) ),  I -1,  129,2  ) 

WRITE  (6,6016) 

FCRMAT(/18X,9HSPL0SSNL-  ,6X, 

36H  NONLINEAR  ?LOSS  FUNCTION  / 

20X,1H1,13X,11HSPLJSSNL(I)  , 8 X, 1 3H 3PL OSSNL ( I ♦ 1 ) /) 

WRITE (6,6100) ( (I,SPLOSSNL( I),SPLOSSNL( 1*1 ) ), I-l, 12  9, 2 ) 

WRITE  (6,6017)  * 
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00125 

00126 
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00128 

00129 


00130 

00131 

00132 


00133 

00134 

00135 

00136 

00137 

00138 

00139 

00140 


00141 

00142 

00143 


00144 

00145 

00146 


00147 

00148 

00149 
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6017  F0RMAT(/18X*9HTNLF-  ,6X, 

1 36H  NONLINEAR  EXECUTION  TIKES  / 

2 20X, 1HI, 13X,11HTNLF< I)  * EX, 1 3HTNLF ( I *1 ) /) 

WRITE! 6,61001 C(I,TNLF( I) »TNLF ( I *1 )) » I • 1* 129, 2» 

WRITE  (6*6018) 

6018  FORMAT !/18X»9HS XI HA TPL-  *6X* 

1 36H  PHASE  LOCK  LOOP  ESTIMATES  / 

2 20X*1HI,13X,11HSX1HATPL (I ) *6x»13HSXlHATPL(I*l) 

WRITE (6*6100) (!I*SX1HATPL (I )* SX1HATPL ( I*i ) > » I -1»129, 2) 
WRITE  (6*6019) 

6019  FORMAT ( / 18X*  9HS ERRP L-  #6X» 

1 3oH  PHASE  LOCK  LOOP  ERRORS  / 

2 20  X * 1HI » 13X* 11HSERRPL ( I ) *8X*13HSERRPL(I+1) 

WRITE (6, 6100) ( (I »SERRPL (I )»SERRPL( 1*1 ))* 1-1*129*2) 
WRITE  (6*6020) 

6020  F0RMAT(/18X,9HSP11PL-  »6X, 

1 36HP11  FROM  PHASE  LOCK  RICATTI  EQUATION  / 

2 20X*1HI*13X*11HSP11PL(I)  » 8X , 13HS? 11  PL ( I *1 ) 

WRITE  (6,6100)  ( (I,SPUPL(I)*SP11PL(I*1)  ),  I -1*1 29, 2) 

200  CONTINUE 

PRINT  CUMULATIVE  SAMPLE  PATH  VARIABLES 
IF  (CUMPATH.AND. (NMC.GT.l) ) GU  TO  310 
GO  TO  400 
310  WRITE  (6*6030 

6030  FORMAT (1H1*30X* 32 HCUMULATIVE  SAMPLc  PATH  VARIABLES  /) 
WRITE  (6*6031) 

6031  FORMAT! /1BX*9HCERRNL-  »6X* 

1 36H  CUMULATIVE  NONLINEAR  ERRORS  / 

2 20X  * 1H I *13X*11HCERRNL (I ) ,8X,13hCERRNL(I*1)  /) 
WRITE  (6,6100) ( ( I*CERRNL( I)»CERRNL ( 1*1) )» I-l* 129,2 ) 
WRITE  (6*6032) 

6032  FORMAT! /18X* 9HCERRPL-  »6X* 

1 36HCUMUL AT  I VE  PHASE  LOCK  ERRORS  / 

2 20X,1HI,13X,11HCERRPL( I)  , 6X , 1 3hCt RPPL I I *1 ) /) 

WRITE  (6,6100) ( ( I,CERRPL(I)*CERRPL( 1*1) )» I-l, 129*2) 
WRITE  (6*6033) 

6033  F0RMAT(/18X*  9HCE  SONL-  *6X* 

1 36HCUMUL AT IVE  NONLINEAR  SQUARED  ERRORS  / 

2 20X*1HI*13X*11HCESQNL(I)  *8X,13HCESQNL(I+l)  /) 
WRITE  (6,6100) ( ( I* CESQNL( I )*CES0NL ( 1*1) )* I»l, 129*2) 
WRITE  (6*6034) 

6034  FORMAT! /18X, 9HCE SwPL-  *6X* 

1 36HCUMUL AT  I VE  PHASE  LOCK  SQUARED  ERRORS  / 

2 20X*1HI*13X*11HCESQPL(I  ) , 8X  * 1 3HCE  $Q?L ( 1 *1  ) /) 

WRITE  (6*6100 (( I*CESJPL( I )»CESCPl ( I«i ))* I«l* 129*2) 
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00175 

00176 

00177 

00178 

00179 

00180 
00181 
00182 


6037 


6038 


60*0 
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WRITE  (6*6035) 

F0RMAT(/18X,9HCEVARNL-  »0X, 

36HCUMULATIVE  NONLINEAR  ERROR  VARIANCE  / 

! 20X, 1HI, 13X,llHCEVARNL (I ) » 8X, 1 3HC EVARNL ( I + 1 > /) 

WRITE  (6*6100) ( ( I*CEVARNL( I ) , CE VARNL ( I*1 ) )* I-l, 129, 2) 
WRITE  (6*6036) 

FORMAT (/18X»9HCEVARPL~  »6X, 

36HCUMUL AT  I VE  PHASE  LOCK  ERROR  VARIANCE  / 

: 20X, 1HI* 13X,11HCEVARPL (I ) »8X» 13HCEVARPL ( I + l ) /) 

WRITE  (6,6100) ( ( I,CEVARPL( I)»CEVARPL(I+1 ) ), I»l* 129, 2 ) 
WRITE  (6*6037) 

F0RMAT(/18X*9HCDBNL-  »6X, 

36HCUMUL ATIVE  NONLINEAR  ERROR  DECIBELS  / 

20X,  1HI,  13X,  11MCDBNL  ( I ) » 3 X , 1 3 HC  D8  NL  ( I + 1 ) /) 

WRITE  (6*6100)  ( ( I * CDBML  ( I ) * CD3NL  ( I +1  ) ) * 1 <•  1 * 129*  2 ) 
WRITE  (6*6038) 

FORMAT ( /18X»9HCD8PL-  ,6X* 

36HCUMUL  AT  I VE  PHASE  LOCK  ERROR  DECIBELS  / 
20X*1HI*13X*11HCDBPL(I)  , 9 X * 1 3HC 03 PL ( I ♦ 1 ) /) 

WRITE  (6*6100) ( ( I*CDBPL (I )*CDBPL( I+l) )* I * 1* 129*2) 
WRITE  (6,6039) 

FORMAT ( /18X,9HCCSNL-  »6X, 

36HCUMUL  ATIVE  NONLINEAR  CYCLE  SLIPS  / 

! 20X*1HI*13X*11HCCSNL( I)  , 8X* 13HCC SNL ( 1*1  ) / /) 

WRITE  (6,6100)  ( ( I,CCSNL(  I),  CCSNU  I+l)  )*  1-1*129,2) 
WRITE  (6*60*0) 

FORMA  T ( /18X»9HCCSPL~  »6X, 

L 36HCUMUL ATIVE  PHASE  LOCK  CYCLE  SLIPS  / 

! 20X,1HI,13X,11HCCSPL(I)  » 3 X , 1 3HCC S P L ( I ♦ 1 ) /) 

WRITE  (6,6100>((I»CCSPL(I)*CCSPL(I+1)),I»1*129*2) 
COMPUTE  THE  MONTE  CARLO  AVERSES 
IF  (NSAMP.LE.30)  GO  TO  10 
I «NS AMP-30 
T«  I 

XERRNL-U8SSUM(CERRNL ( 31 J I ) )/T 
XESJNL»08SSUM(CESQNL(31; I ) ) / T 
XCSNL»Q3SSUM(CCSNL(31;I ) )/T 
XERRPL"08SSUM(CERRPL ( 31  * I ) )/T 
XES0PL»Q8SSUM(CES0PL(3l;l))/r 
XCSPL-0HSSUM(CCSPL(31;1) )/T 
XEVARNL-XESONL-XERRNL*XEPRNL 
XOBNL ■DBEPS 

IF  (XEVARNL  .GT.EPS(  1 ) ) X DBNL  ■ 10 . 0*  ALUG 10  ( X F.  V ARNL  ) 

XEVARPL«X(SQPL-XERRPL*XERRPL 

XDBPL  «0BEPS 


13.39  HRS.  31MAY 
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• 00193  IF  (XEVARPL.GT.EPS(l)  ) XDBPL »10 . * AcOGlO ( X EV AR PL) 

C PRINT  THE  MONTE  CARLO  AVERAGES 

0018A  WRITE  ( 6*  6050 ) NMC  » XE  RRNL  » XERRPL  » XE  SQNL  # XE  SC  PL  # XEVARNL#  _ 

1  XEVARPL»XDBNL»XD8PL»XCSNL»XCSPL 

00185  6050  F0RNAT(1H1#25X»30HMQNTE  CARLO  SUMMARY  STATISTICS//  ' 

1 32X# 1H( # 14# 14H  SAMPLE  PATHS)// 

2 36X, 16HN0NLINEAR  FILTER# 5X#15HPHASE  LOCK  LOOP// 

3 14  X#  14H***VARIABLE***#7X#12H***VALUES***»9X# 

A 12H**  + VALU'ES***//1AX»13HAVERAGE  ERR0P.9X# 

5 E15.8#6X#E15.8/ 

6 10X#21HA VERAGE  SQUARED  ERROR# 5X. El 5 . 8, 6X. E 15 . 8/ 

7 14X# lAhERPOR  V AR I ANC E# 8 X# E 15 . 8 # 6X# E 1 5 . S / 

8 14X# 14HV ARIANCE  IN  DB # 8 X # E 15 . 8 # 6X# E 1 5 . 8/ 

9 11X.19HAVERAGE  CYCLE  S L I P S # 6 X » E 1 5 . 6 , t>X  . E 1 5 .8  ) 

00186  6100  FORMAT (20X# I A # 8 X # E15.8#4X#E15.8  ) 

00187  GO  TO  10 

00188  500  STOP 

00189  END 


NO  ERRORS 


FORTRAN  R1.2  CYCLE  115P2  0«B  SGURCE  LISTING 

00001  SUBROUTINE  VPRUP(A,I) 

00002  REAL  AU66A0) 

00003  INTEGER  I 

0000 A INTEGER  MD1,M02, H03# MOA, MD5# MD6»MD7, 

1 MD8»MD9»MD10>MD11*MD12»MD13,MD1A,MD15»  MO  16 

00005  COMMON  /CPROP/  ND1» MD2> MD3» MO A» MD5> MD6» HO 7» 

1 M08,MD9,MD10,MD11,MD12,MD13,MD1A,M015,MD16 

00006  IF  (I .GT.O)  GO  TO  10 

00007  A(MD2iMDl)-A( 1JM01) 

C0008  A(MDA;MD3)-A(1;MD3) 

00009  10  A(M0b;MD5)-A(l;M05) 

00010  A(M08jMD7)-A( l;M07> 

00011  A ( MD10JM09) • A ( 1 j M 09 ) 

00012  A(M012;M011)-A(ljM011) 

00013  A(M01A;MD13)-A(1;MD13) 

0001 A A(M016}MD15 )»A(1;M015) 

00015  RETURN 


13.39  HRS.  31NAY7 


FORTRAN  R 1 . 

00001 

00002 
C0003 
0000  A 

00005 

00006 

00007 

00008 

00009 

00010 
00011 
00012 
00013 
000 1A 

00015 

00016 
00017 

NO  ERRORS 


SOURCE  LISTING 


10 


20 

30 


CYCLE  115P2  0-B 

SUBROUTINE  M0D2P 1(A) 

REAL  A(130)*X(130)>Y(130) 

BIT  B T <1301 

COMMON  /PROS/  TWQP I » P I 
x ( l ; 130 ) *p i 

BT(l;130)-(A(l;130).GT.X(l;130)) 

IF  (08SCNT (3T ( 1 * 130) ) . t Q . 0 ) GO  TO  20 
Y(1»130)»A(1;130)-TW0PI 

A(l;l30)-Q8VMASK( Y ( 1 ; 1 30 ) , A { 1 ; 1 30 ) , BTIli I 30) J A( 1 ; 1 30  > » 
GO  TO  10 
X ( 1 » 1 30 ) »-P I 

BT(1»130)“(A(1;130).LT.X(1#130)> 

IF  (08SCNT(BT(1;130) ) . LQ .0 ) RETURN 
Y(l;l30>«A( li 1 30 1 +T  WOP  I 

A(l;130)"Q8VMASK(Y(l;i30)»A(l;130)»BT(l;130)JA(l;130i ) 

GO  TO  30 

END 


13.39  HRS, 
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00001  REAL  FUNCTION  VA VG ( A V » X » I ; ♦ ) 

00002  DESCRIPTOR  AV.X.VAVG 

00003  INTEGER  I 

OOOOA  REAL  XI  ~ 

C000t>  X I * I 

00006  VAVG  •( (XI-1.)*AV+X)/XI  ' 

00007  RETURN  

00008  END  ■— 

NO  ERRORS 


| 

I 


: 


V 


77 


SOURCE  LISTING 


FORTRAN  R1.2 

00001 

00002 
00003 
00009 

00005 

00006 

00007 

00008 

00009 

00010 
00011 
00012 
00013 
00019 

0001b  10 

00016 

00017 

00018 

00019 

00020 
00021 
00022 
00023 
00029 

NO  ERRORS 


CYCLE  115P2  0-B 

REAL  FUNCTION  RNF(INIT) 

INTEGER  INIT>K,KD*M1,M2»N1,N2>NT,MP 
REAL  T 1 » T2 

COMMON  /RNUM/  K, KD, M 1 , M2, N 1, N2, NT » MP» T 1, T 2 

IF  (INIT.EQ.O)  GO  TO  10 

Nl-299739 

N2-159551 

N1  »102993 

N2-165617 

Ml-299739 

M2 ■ 1 5 35  5 1 

Tl-2. ♦♦ i-18 I 

T2»2. ♦*<-36 ) 

MP»2**18 

K»M2*N2 

KO-K/MP 

NT  »K-KD*MP 

K-ML*N2*M2*N1*KD 

KD-K/MP 

N1  «K-KD*MP 

N2MT 

RNF»N1*T1*N2*T2 

RETURN 

END 


13.39  HRS.  31MAY7 
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FORTRAN  R1.2 

00001 

00002 

00003 

00004 

00005 

00006 
00007 
00006 

00000  10 
00010 
00011 
00012 

00013 

00014 

00015 

00016 
00017 
00016 

00019 

00020  20 
00021 

00022 

00023 

NO  ERRORS 


CYCLE  115P2 


SOURCE  LISTING 


REAL  FUNCTION  GA USS ( IN  I T , SO, X M ) 

INTEGER  INIT,I,J 

REAL  SD»XM>TWQPI>X;XR1*XR2 

COMMON  /GNUM/  I,J,XR2 

COMMON  /PROB/  TtoOPI 

IF  (INIT.EQ.C)  GO  TO  10 

I-l 

J«1 

IF  (J.NE.l)  GO  TO  20 
J-2 

XR1-RNF(I ) 

1-0 

XR2-RNFI0) 

X ■ SQR  T (ABSC-2 .*AL0G(XR1) ) ) 

XR2-TW0PI*XR2 

XR1»X*SIN(XR2) 

XR2«X*COS<XR2) 

GAUSS-XR1*SD>XM 

RETURN 

J-l 

GAUSS "XR2+SD+XM 

RETURN 

END 


I 


FORTRAN  R1.2  CYCLE  115P2  O-B  SOURCE  LISTING  13.39  HRS.  31MAY 

00001  SUBROUTINE  ST ATE ( MC » S AM P, XI, 2 1, 22 ) 

00002  INTEGER  MC.SAMP.INIT 

00003  REAL  XI.  Zl» Z2. OE VI,  DEV2* 0EV3* OE V*. X2 

0000**  COMMON  /STA/  D EV1 » DE  V2,  D E V3, 0 E V«*.  I NI T 

00005  COMMON  /PROS/  TwOP I . P I » ALP 110, D EL F , G22C » Y 1 E S T , Y 2E ST , A1 1 , A22 , 

1 CONST, 0EL,FTC,PIDEL,P110,RDEL,RX»0C.Q22»M0, NO 

00006  IF  (MC.NE.O)  GO  TO  10 

00007  DEV1-S0RT( All) 

00008  OE  V2«  SQR  T ( A22 ) 

00009  DEV3»S0RT( RDEL) 

00010  DE  V**-$QRT(322) 

00011  INIT-1 

00012  RETURN 

00013  10  IF  (SAMP.GT.O)  GO  TO  20 

0001*.  X1*GAUSS  ( INIT  .OEVl.YltST  ) 

C0015  INIT-0 

00016  X2-GAUSS(0,DEV2» Y2EST) 

00017  RETURN 

00018  20  IF  (SAMP.LE.l)  GO  TO  SO 

00019  X 1 ■ X 1 *X2*DE  L 

00020  X2-GAUSS(G»DEV**,X2) 

00021  30  Z1>GAUSS(0.0EV3.CGS(X1) ) 

00022  Z2-GAUSS(0.0EV3.SIN(X1) ) 

00023  RETURN 

0002**  END 

NO  ERRORS 


25 
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00001  SUBROUTINE  PLL  UIC# SAMP, 2 1,  Z2, XlhAT, PF1 1 ) 

00002  INTEGER  MC»SAMP 

00003  REAL  Z 1 , 2 2 , XI HA T , P F 1 1 , DEN, S INF  1 ,C OS F 1 , 

1 X2HAT,PD11»PD12»PD22»PN11»PN12»PN22 

00009  COMMON  /PLO/  DEN, X2HAT, PNll# PN12, PN22 

00005  COMMON  /PROB/  TWOPI  , P I , A LP  1 10  , DE  L F,  322C  , Y 1 E S T , Y 2 E S T,  All , A22  , 

1 CONST, DEL, FTC, PI0EL,P1I0,RDEL,RX,QC, 022 

00006  IF  (MC.LE.O)  RETURN 

00007  IF  (SAMP.LE.O)  GO  TO  20 

00008  IF  (SAMP.LE.l)  GO  TO  10 

00009  X1HAT»X1HAT*DEL*X2HAT 

00010  PD11*(RDEL*(PN11+2.0*PN12*DEL)-PN12*PN12 


1 *DEL*DEL)*DEN*PN22*DEL*DEL 

00011  PD12»PN12MRDEL-PN12  + DEL)*DfcN«-PN2  2*DEL 

00012  PD22»-PN12*PN12*UEN*PN22*Q22 

00013  PNll-PDll 

00019  PN 12*  PD  12 

00015  PN22-PD 22 

00016  DEN-1. 0/(PNll«-RDEL) 

00017  10  PF11-PN11*RDEL*DEN 

00018  SINF1-SINEX1HATJ 

00019  COSFI-COS(XIHAT) 

00020  X1HAT-X1HAT+DEN*(-PN11+SINF1*Z1*PN11*C0SF1*Z2I 

00021  X2HAT-X2HAT  + DENM  -PN1 2*S I NF 1 ♦ Z 1 +PN 1 2 + C OSF 1* Z 2 ) 

00022  RETURN 

00023  20  XlHAT -Y1EST 

00029  X2HAT-Y2EST 

00025  PN11-A11 

00026  PN22-A22 

00027  PN12-0. 

00028  DEN*1.0/(PNll+RDEL  ) 

00029  RETURN 

00030  END 
NO  ERRORS 
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FORTRAN 

OOOOl 


00002 

00003 

0000* 

00005 

00006 

00007 

00006 

00009 

00010 
00011 
00012 

00013 

0001* 

00015 

00016 

00017 

00018 


R1 » 2 CYCLE  115P2  0-B  SOURCE  LISTING 

SUBROUTINE  NLF ( MC » S AMP, 2 l , Z2» SHAT* CHAT* TnLF) 


13.39  HRS.  31MAY7 


POINTMASS  FILTER  FOR  TWO  DIMENSIONAL  PHASE  ESTIMATION 
PROGRAMMED  BY  KENNETH  D.  SENNE  JUNE  2*,  1976 


INTEGER  MC, SAMP, MD, ND, MND, MNO  1 
INTEGER  MD1,MD2,MU3»MU*,MD5,MD6,ND7, 

1 M08,MD9,MD10,MD11,MD12,MD13»MD1*»MD15, MD16 

REAL  Zi,Z2»SHAT, CHAT, TNLF 

INTEGER  I,U,J,Jl,J2»K,NC,NT,NTERM,NTE*M33 
REAL  A11,A22,CL»CN3RM,C0NST,CR»PI,PIDEL,J22,T, 

1 TT,Y1EST,Y2EST,TEMP, TEMPI, TEMP  2 

REAL  Si(6*),S2(6*)»  S I GMA ( 6* ) , PS  I ( 256 ) , A(236) 

REAL  I N ( d > 

BIT  DOT#  8 T ( 1 66*0 ) 

INTEGER  D JNM, D JNS 
INTEGER  JNS ( 256) , JNM ( 512 ) 

REAL  COSY  ( 1638*),  DELJ(  166*0),  JO  (163  8*),  JNI 1638*),  JNl(  327t>8), 
1 JNA(32768),SINY(l636*),SNl(lb3b*) 


COMMON  /PPOB/  TW0PI,PI,ALP110,0ELF,022C, Y IE S T, Y2E S T, A 11 , A 2 2 , 

1 CONST, DEL, FTC, PIDEL, P110#RDEL»RX, 00,  C22, MD,ND 
COMMON  /NLFC/  NC,NT,NTERM,NTERM33,S1,S2,5IGMA,PSI,A,C0SY,DELJ, 
1 JO,JN,JNS,SINY 

COMMON  /C  PR  OP / MDD,MD2,MD3,MD*,MD5,MD6,MD7, 

1 MD8,MD9,MD10,MD11,MD12,MD13,MD1*,MD15,MD16 

IF  (SAMP.LE.O)  GO  TO  100 


C 

SAMPLE  PATH  UPDATE  TAKES  PLACE  HERE 

C 

C 

C 

r 

SET  CLOCK 

00019 

V* 

CALL  J3CL0CKS(T,TT) 




SOURCE  LISTING 
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FORTRAN  R1.2 
C 
C 

00020 

00021 

00022 

00023 

C 

C 

C 

0002*. 

00025 

00026 
03027 
0002U 
00029 


C 

C 

C 

00030 

00031 

C 

C 

C 

00032 

00033 

00034 

C 

C 

C 

00035 

C 

C 

C 

00036 

C 

C 

c 

00037 

C 

C 

C 

00038 

00039 

00040 

00041 


CYCLE  115P2  0-B 

EVALUATE  SENSOR  TERMS 

DSN1>  Z1*DS1 
DSN2-22*0S2 
DSN1 » JSN1+DSN2 
DSN1-VEXP(DSN1;DSN1> 

PROPAGATE  SENSOR  TERMS 

SNl(33;32)"SNl(l;32) 

SNl(b5;64)"SNl(l;64) 

SNl(129il20)-SNl(lil28) 

SN1(257;256)-SN1C1;256) 
SN1(1025;1024)-SN1(1;1024> 

SN1 (2349; 2048 ) -SN1 ( l;2048) 

SCRAMBLE  THE  JN  TO  ORDER  FOR  J(N«-1) 

CALL  30VXTOV(X,O2,»O»DJNM»O»DJND.O» DJN1F) 

CALL  JBVXTUVl X *02 • » 0, 0 JN S » 0» D JN1D> 0» D JN Al S I 

FORM  THE  INTERPOLATED  MATRIX 

DJN1S-DJNA2S-DJNA1S 
DJNIS-DDEL J*DJN1S 
DJN1S-DJNA1S+DJN1S 

COMPRESS  OUT  THE  LAST  RUrf  OF  INTERPOLATED  VECTOR 
0JN4-QSVCMPRS (D JN IS » OUT ; DJMA ) 

COPY  THE  END  COLUMNS 
OJNAENT-OJNABNT 

INITIALIZE  CONVOLUTION  (A(O)-l) 

DJN1-DJNANC 

CONVOLUTION  LOOP 

Jl-NC 

J2-NC 

DU  10  I«1,NTIRM 
J 1 ■ J 1+MD 


l 


I 


28 


r 

1 
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CYCLE  115P2  0 ■ B SOURCE  LISTING 

13.39  HRS.  31MAY7 

00092 

J2-J2-MD 

00093 

ASSIGN  DJNAJ1>JNA(J1;MND) 

00099 

ASSIGN  DJNAJ2,  JNAU2J1ND) 

000*1  5 

DJN-DJNAJ1+DJNAJ2 

0009  6 

DJN-AII >*DJN 

00097 

10 

DJN1-DJN1+DJN 

C 

C 

MULTIPLY  BY  SENSOR  TERMS 

C 

[ 

00098 

c 

0JN1-DSN1A*DJN1 

c 

GET  NORMALIZATION  CONSTANT 

i 

c 

00099 

CNORM«SUMLOG( JN1) 

| 

00050 

c 

CNORM-l.O/CNCRM 

c 

TRANSFER  THE  NORMALIZED  DENSITY 

l 

c 

[ 

00051 

c 

D JN»CNORM*D JN1 

! 

c 

CUMULATE  ESTIMATES 

f 

c 

00052 

DJNA1-DSINY*DJN 

r‘ 

00053 

SHAT-SUMLOGUNA) 

\ 

0005  A 

DJN41»OCOSY*DJN 

s 

i 

[' 

00055 

c 

CH4T»SUML0G( JNA) 

c 

TIMEOUT 

c 

[ 

00056 

CALL  U3CL0CKS <TNLF,TT ) 

• . 

00067 

c 

RETURN 

i * 

V. 

c 

h | 

c 

l — — — — 

c 

j 

c 

SAMPLE  PATH  INITIALIZATION  TAKES  PLACE  HERE 

c 

00058 

100 

IF  (MC.LE.O)  GO  TO  200 

c 

c 

TRANSFER  THE  INITIAL  OENSITT  FOP  NEW  SAMPLE  PATH 

I 

c 

00059 

JM1;MND)-J0(  1JMN0) 

00060 

RETURN 

-»y^  *■ 

• V - 

29 

[ V 

*k. 

1 

m, • • I 
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FORTRAN  kl.2  CYCLE  115P2 
C 

C 

C 

C 

C 

C 

C GLOBAL  INITIALIZATIONS  OCCUR  HERE  FOR  THE  ENTIRE  RUN 

C 

C 

C DETERMINE  THE  NUMBER  OF  CONVOLUTION  POINTS 

C 


00061 

00062 

00063 

00064 
00066 
00066 

00067 

00068 
00069 
000  70 

00071 

00072 

00073 

00074 

00075 

00076 

00077 
00076 

00079 

00080 
00081 
00082 

00083 

00084 

00085 

00086 


00087 

00086 

00069 

00090 

00091 


C 

C 

C 


200  NTERM»(ND/2.)*SQRT(50.*022)/PIDEL*0.5 
MD1«HJ*1 
MDD-MD 
MD2-M0D-H 
MD3  »NDD*2 
MD4-M03+1 
MD5«ND3*2 
HD6-M05+1 
MD7»MD5*2 
MD8-M07+1 
MD9»M07*2 
MDlO*M09*l 
MD11»ND9*2 
MO  1 2 • MD1 1 ♦ 1 
MD13»MD11*2 
MD14»MD13*1 
MD15-MD13*2 
MD16-MD15+1 
MND»MD*ND 
M1ND-MD1*N0 
MNDl-MND+1 
NTt'RM33-M0*NTERM 
NT»2*NTERM33 
NC«NTERM33*1 
MND2"  2 + MND 
ND2»N0*2 

SET  UP  THE  VECTOR  DESCRIPTORS  FOR  THE  UPDATE  FUNCTIONS 

ASSIGN  DS1»S1(1;MD) 

ASSIGN  DS2 » S2 ( i ; MO) 

ASSIGN  DSN1,SN1(1;M0) 

ASSIGN  DSN2  » JNA < 1 » MO ) 

ASSIGN  OJN»  JM  1 * MND  ) 


30 
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FORTRAN  R1.2 
00092 


00093 
0009  A 

00095 
0009b 
00097 

00096 

00099 

00100 
00101 
00102 
00103 
0010* 

00105 

00106 
00107 
00100 

00109 

00110 


00111 

00112 

00113 

0011* 

00115 

0011b 

00117 

00118 


00119 

00120 


00121 

00122 

00123 

0012* 

00125 

00126 
C0127 


crciE  l 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 

ASSIGN 


1 5P2  U«8 

DJNH,  JNM(l;N02» 

OJNO, JNIliMO) 
DJN1F#JN1(1;MN02) 
DJNSt JNS( liND) 

DJN1D,  JNlIDMOi) 
OJNAlS.JNAdjMIND) 
DJN1S# JN1C1 JMIND) 
DJNA2S»  JNA ( 2 ; M 1ND ) 
DOELJ»OtLJ(l»MND) 

obt#bt(1;hino) 

DJNA>  JNA( 1 ;HND ) 

DJNI,  JN1( 1;MND> 
DJNAENT, JNA«  MN01JNT  ) 
OJNABNT  * J NA  ( 1 j NT ) 
DJNANC> JNA(NCJMND) 
DSN 1 A. SN1 ( 1; MND ) 

dsiny,simy(1;mnd) 

DCOSY»COSY(l;MND) 
0JNA1# JNACIJMND) 


PHASE  VARIABLES 


OCI  210  l ■ 1 » NO 

SIGNAC  I > -P I ♦ < (2. *1-1 . )/HD  -1.) 
CUSYCD-COSCSIGHACI)  ) 

SINYC I )«SIN(SIGHA(I ) ) 
Sim»COSY(I)/RDEL 
S 2 ( I ) -SINYC  I)/kDEL 
CALL  VPkOP ( S INY  »0 I 
CALL  VPROP (COSY. 0 ) 


PHASE  RATE  VARIABLES 


DO  220  I *1 » ND 

PS  I (I  )«PIDEL*U2.*I-1.  >/ND 


SET  UP  THE  BIT  VECTOR 


Il-l 

DO  235  1*1 # ND 
DO  230  J« 1 » HD 
BT  C I1I*B' 1' 

1 1 - 1 1 ♦ 1 
BTCI1)-B'G' 
11-11*1 


SB:.' 


m 


wdfei 


FORTRAN  R1.2  CYCLE  115P2  O-B  SOURCE  LISTING 

C 

C SETUP  THE  TRANSFER  MATRIX 

C 


00128 

00129 

00130 

00131 


DU  240  J - 1 » ND 

J 1-MOD IND-l-NTERM+J# NO) *MD*2 
Il»Jl*M0DIMD*MD/2+33-l 135-NTERM+J ) /4*MD) 
240  JNS ( J ) ■ 1 1 


C 

C SETUP  INTERPOLATION  MATRIX 

C 


00132 

00133 

00134 

00135 

00136 

00137 

00138 

00139 

00140 

00141 

00142 

00143 
> 00144 

00145 


INI 1> -0.075 
INl2)-0.625 
INI  3) -0.375 
I N 1 4 I -0.125 
INI5)-IN(1) 

I N I 6 ) -INI2) 

INI  7) -INI  3 ) 
INI3J-INI4) 

J- MOD I NTERM*  4 ) 
DO  245  1-1*4 
II— II— II *M0 l+l 
J 1 ■ I ♦ 4- J 
T-INI Jl) 

245  DELJI 1 1 ; MD 1 ) • T 


C 

C SET  UP  THE  EXPANSION  VECTOR 

C 


00146 

00147 

00148 

00149 
C0150 

00151 

00152 

00153 

00154 

00155 

00156 

00157 

00150 


11-1 

J 1 ■ 4*M0 1 
DO  250  I ■ 1 * MD 
DO  250  J-1*J1 
J2-I1+J1 

DELJI J2I-0ELJII1I 
250  n-im 

11- 3 

12- 2+ND 

DO  265  1-2*12*2 
JNMI I — 1 1 — 1 1 
JNMII 1—11 
265  I 1 - I 1 *MD 


C 

C EVALUATE  CONVOLUTION  TERMS  All) 

C 


13.39  HRS.  31MAY 


00159 

00160 


DO  280  I ■ 1 » NT  ERM 
T • I 


FORTRAN  R1.2 
00161 
00162 
00163 
0016* 

00163 

00166  280 


00167 

00168 

00169 

00170 

00171 

00172 

00173 
0017* 

00175 

00176 

00177 


SOURCE  LISTING 


00178 

00179 


00180 
0018 1 
00182 


6000 


6001 


CYCLE  115P2  0-8  S 

TT-ND 

TfcHP-T/TT 

TEHP-CONST*TEMP*TEHP 

AIII-O. 

IF  (TEMP.GT.-*7)  A( I ) -EXP( TEMP ) 
CONTINUE 

CONSTRUCT  THE  A PRIORI  DENSITY 


C NORM -1.0/ (TWOPI*SORT( All*A22 ) ) 

CL— 0.5/A22 
SI—  0.5/All 
DO  290  I-1»MD 
1 1- 1 

CR-SIGMACI >-YlcST 
CR-CR*CR*SI 
DO  290  J-lf ND 
TEMP-PSI (J)-Y2EST 

JO « 1 1 )-EXP(TEHP*TENP*CL*CR)*CNORN 
II-I1+M0 

WRITE  OUT  PARAMS  OF  NLF 
WRITE  (6*6000)  MD*ND»MU1 *ND 

FORMAT (1H0*26X*27HP0INT  MASS  NONLINEAR  FILTER// 1H  , 

L 28X*  2*HVERSI0N  2,  CODED  6/27/76//1H  * 

! 18X#I3,1HX, I3.25H  DENSITIES  REPRESENTED  dT  »I3#HX,I3) 

WRITE  (6*6001)  NTfcRM* (A(I)*I-1*NTERM) 

FORMAT ( 1H  *33X*7HA(1)-A(*I2*2H)  / ( 1 X, 5E 1 3 . d ) ) 

RETURN 


13.39  HRS.  31MAY7 


■ i mm'  ■ 


m 

• i ! 


FORTRAN  R1.2  CYCLE  115P2  U-B  SOURCE  LISTING  13.39  HRS.  31MAY7 

00001  FUNCTION  SUMLQG(A) 

00002  REAL  A C 61  92  ) » C(4096) 

C 

C SUNLOG  - SUM ( A ( 1 ) # . . ,A(2**N?A)) 


c 

DOMAIN  » b .LE.  N P A .Lt.  13 

00003 

NP  A ■ 12 

00004 

NA  ■ 2 **NP  A 

00005 

LC  ■ NA/2 

00006 

C(liLC)  • A( l;LC > ♦A ( L C ♦ 1 J LC) 

c 

LOOP 

00007 

20 

LC  - LC/2 

OOOOB 

IF ( LC  .LT.  4)  GOTO  50 

00009 

C(ULC)  ■ C(1JLC)+C(LC* 

00010 

GOTO  20 

c 

END  LOUP 

00011 

50 

CONTINUE 

00012 

SUMLOG  -CC1)  ♦ C ( 2 ) ♦ C C 3 1 ♦C  C 

00013 

RETURN 

00014 

END 

NO 

ERRORS 

H 


Cray  Code 


r~ 


I 


I - 3 


The  Cray  I from  our  point  of  view  had  the  most  potential  for  our 
problem.  However  the  code  development  centered  on  tricks  to  make  the 
Cray's  compiler  use  the  full  potential  of  the  machine;  in  particular  to 
force  chaining  and  efficient  use  of  the  available  hardware  potentialities. 
It  would  seem  that  assembly  language  coding  of  this  machine  should  be 
undertaken  in  order  to  effectively  use  the  potential  of  this  machine. 

We  achieved  33  megaflops  with  the  following  code.  The  reader  should  note 
that  the  philosophy  that  is  most  useful  here  is  to  produce  a small  number 
of  loops  which  perform  a large  number  of  instructions  in  the  inner  loop. 
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C CRAY  FORTRAN  COMPILER  VERSION  I.05X  02/21/79 

C COMPILATION  DATE  AND  TIME  05/21/79  - 07:46:59 

SUBROUTINE  NLF(MC,SAMP,Z1  ,Z2,SI!AT,C!!Ar,TNLF) 

INTEGER  MC.SAMP 

REAL  Z1,Z2, S1IAT, CHAT, TNLF 

COMMON  /LCH1 / T20A,  T25A,  T30A,  TAOA,T60A,T /0A.T90A 
INTEGER  I,Il,J,K,NC,NTERM,NSIZE 
INTEGER  JNSC128) 

REAL  ALP1 10, A1  1 ,A22, CL, CNORM, CONST, CK,  OEL,DELF,FTC,  DT  , PI1)EL,P1  10, 
1 QQ,Q22.,Q22C  ,P-DEL,RX,SI , T, TEMP, TT,T, OPT, Y 1EST,Y2EST 

REAL  COSY(32),SINY(32),SNl (32), SI (32),S2(32),SIGMA(32),TROW(32) 
REAL  A (10) ,DELJ (1 28), PS 1(123), V 1(128), V2 (128) 

REAL  JN (33, 129) , JM1 (33, 149) , JO (33, 12? ) 

COMMON  /PROS/  TUOPI,PI,ALPl 10,DELF,Q22C, Y1EST, Y2EST, 

1 All  ,A22,CONST,DEL,FTC  ,PIDEL,P110,RDKL,RX,*'0,Q22 

COMMON  /NLFC/  NC .NT.NTERM ,S 1 ,S? ,S ICMA, PST, A, COSY , 

1 DEI.J  , JO,  JN  ,SINY 

C IF  SAMP  NOT  POSITIVE  THEN  REINITIALIZE 

IF  (SAHP.LE.O)  CO  TO  100 

C THE  FOLLOWING  CONSTITUTES  THE  TIME  SEGMENT 

C SET  CLOCK 

T-SECOND(I) 


C EVALUATE  SENSOR  TERMS 

DO  10  1-1,32 

VI (I )-Z 1*S1 (I )+Z2*S2(I) 

C ***  NEXT  ONE  OUT  FOR  CRAY  *** 

C IF  (Vl(I).LT.-l  15.)  VI(I)— 115. 

10  SN1  (I)-F.XP(Vl  (I)  ) 

C TRANSFER  JN  WITH  COLUMNS  CYCLICALLY  ROTATED  TO  JN1 

T1  - SECOND(l) 

DO  20  J-1,128 
CDIR$  IVDEP 

K-129-J 
DO  15  1-1,32 
15  JN (I+32,K)-JN (I ,K) 

DO  20  1-1,33 

JN1 (I ,K+1 0)-JN (I+JNS (K) , K) 


20  C CONTINUE 


c 


EXPAND  ENDS  OF  JN1  !>Y  CYCLICALLY  COPYINC  COLUMNS 


T2-SECOND(l) 

DO  30  J-1,NT£RM 
DO  30  1-1,32 

JN1 (I, -J+l I)-JN1(I,-J+139) 
30  JN1 (I , J+l 38)-JNl (I , J+l 0) 
T30-  SECOND ( 1 ) - T1 


I 


C CONVOLUTION  IN  JNl  TO  JN 

Tl-SECOND(l) 

DO  40  1-1,32 

DO  40  J-1,128 

JN (I , J)-JN 1(1, J+l 0)  + A(l)*(JNl(I,J+9)  + JNl (I, J+l 1)) 

1 + A(2)*(JNl(I,J+8)  + JNl (I, J+12) ) 

2 + A(3)*(JNl(I,J+7)  + JN1(I,J+13)) 

3 + A(4)*(JNl(I,J+6)  + JNl (I.J+14)) 

4 + A(5)*(JN1  (I,J+5)  ■+  JNl  (I,  J+l  5)) 

40  CONTINUE 

T40-  SECOND( 1)  - T1 


C ACCUMULATE  ROW  SUMS  BY  COLUMN  j 

DO  50  1-1,32 
50  TROW ( I ) - JN (1,1) 

Tl-SECOND(l) 

DO  60  J-2,128 
DO  60  1-1,32 

60  TROW (I )»TROW (I )+JN (I , J ) 

T60-  SECOND(l)  - Tl 


C COMPUTE  ESTIMATES  AND  NORMALIZATION  CONSTANT 


VI ( 1 )»TROW( 1 )*SN1 (1 ) 
CNORM-V1 ( 1 ) 

Tl-  SECOUD(l) 

DO  70  1-2,32 

VI (I ) -TROW (I )*SN1 (I) 


CHORM -CNORM  +V 1 (I) 

T70-  SECOND ( 1 ) - Tl 
SHAT-DOT (VI , 1 ,SINY, 1,32) 
CHAT -DOT (V 1 , 1 .COSY , 1 , 32 ) 
CNORM -1. /CNORM 
SHAT-SHAT*CNORM 
CHAT-CIIAT*CNORM 


TRANSFER  NORMAI.IZF.D  DENSITY 


Tl -SECOND (1) 

DO  90  1-1,32 
TEMP-SN 1(1) *CNORM 
DO  90  J-1,128 
JN  (I , J )»TEMP*JN (I , J) 

CONTINUE 

TOO-  S KCOND ( l ) - Tl 
TNLF-SF.COND  (TT)-T 

PRINT  l234,T20,T25,T30,T'.0,T60,T7O,TPn 

FORMAT ( " 20,  25,  30,  40,  60,  70,  90  ", 


o r> 


T2PA-T20A+T20 
T25A-T25A+T25 
T30A-T30A+T30 
T A 0 A -T  A OA+T  A 0 
T60A-T60A+T60 
T 70A-T70A+T70 
T90A-T90A+T90 

THE.  VARIABLES  ABOVE  ARE  INITIALIZED  TO  ZERO  BY  THE  LOADER  SINCE 
THEY  ARE  IK  LABELLED  COMMON  (SOPPY  BUT  SHOULD  BE  OK). 


C TIMEOUT 


C THIS  Ef.'DS  THE  TIMED  SEGMENT 

RETURN 

C * * * * NOTHING  BELOW  THIS  POINT  REQUIRES  VECTORIZATION  * * * * 


C IF  MC  NOT  POSITIVE  THEM  GLOBAL  INITIALIZE 

100  IF  (MC.LE.O)  CO  TO  200 

C SAMPLE  PATH  INITIALIZATION 

DO  110  1-1,32 
DO  110  J-l,l2? 

110  JN(l,.J)-JO(I,J) 

RETURN 

C GLOBA!.  INITIALIZATIONS  FOR  NONLINEAR  FILTER 

200  NSIZE-10 

MT  ERM -6  A • 0*SQRT ( S 0 . *Q  2 2 ) / P I DE  L+0 . 5 
IF (MTERM.GT.NS IZE)  MTERM-NSIZE 

C PHASE  VARIABLES 

DO  210  1-1,32 

SIGMA (I )-PI*( (2.*I-1 • )/32.-l . ) 

COSY  (I )-C0S (SIGMA(I ) ) 

SIMY(I)«SIN(SIOMA(I)) 

S l (I )-COSY (I ) /RDEL 
210  S2  (I  )-SINY  (I  ) /RDF.L 


C PHASE  RATE  VARIABLES 

DO  720  1-1,128 

220  PSI(I)-=>IOEL*((2.*I-l.)/129.-l.) 

C SETUP  THE  TRANSFER  MATRIX 

DO  2 AO  I-1.12F 

ZAO  ,!NS  (.1  )-MOD ( •>  — (.)  — 1 )/A,  32) 
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SETUP  TIIK  IN’TFKPOIATION  VECTOR 


DELHI  )-f).»75 
DFLJ  (2) -0.625 
DELI  (3)-0. 375 
DEI.J(4)-0. 1 25 
1)0  250  [-5,125,4 
DKLJ  (I  )-l)ELJ  (1-4) 

DELI  (I+1)-DELJ (1-3) 

1IELJ  (l+2)-DELJ  (1-2) 
nr.LJ(i+3)-r»Ei.j(i-i) 

EVALUATE  CONVOLUTION  TERMS  A(I) 

DO  280  I-l.NTERM 
TFMP-I/12R. 
rKNP-CONST*TEMP*TFMP 
A(I)-0. 

IF  (TEMP.CT.-47.)  A(I )-EXP(TEMP) 

CONTINUE 

CONSTRUCT  THE  A PRIORI  DENSITY 

CNORM - 1 . 0 / (TWOP I *SQRT (A  1 1 *A  2 2 ) ) 

CL— 0.5/A22 

SI—  0.5/All 

DO  2"0  1-1,32 

CR-SIC.MMA(I  )-YlEST 

CR-CR*CR*SI 

DO  290  J-1,128 

TEMP-PSI  (J)-Y2KST 

TKMP-TEMP*TF.MP*CI.*CR 

***  NEXT  TWO  OUT  FOR  CRAY  *** 

J0(l,J)-0. 

IF  (TFMP.OT.-l  15.)  .10(1 , J)-EXP (TEMP) *CNO«?M 
***  NEXT  ONE  IN  FOK  CRAY  *** 

JO  (l  ,.l  )-EXP(TFJ1P)  *CNORM 

CONTINUE 

RETURN 

END 
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II  - I 


CDC  7600  Code  for  the  3"D  Problem 


The  three  dimensional  phase  demodulation  program  code  was  developed 
simultaneously  for  the  7600  and  the  Star  100  in  order  to  have  a check  on 
each.  The  7600  was  not  effective  on  this  program  as  with  level  1*33  the 
optimizing  compiler  d i d not  produce  runable  code,  the  extended  memory 
address,  calculations  failed.  When  the  0pt=l  compiler  was  used,  times  of 
20  to  30  times  slower  than  the  Star  resulted,  while  on  the  2D  problem  the 
7600  was  only  5 times  slower  than  Star.  The  compiler  failure  was  sub- 
mitted to  Control  Data  as  a problem  and  acknowledged  but  never  solved. 

The  reader  could  view  the  7600  code  as  the  scalar  version  of  the  3D  Star 
Code  which  follows  in  II  - 2.  It  is  apparent  that  the  7600  is  not  as 
effective  as  the  Star  and  Cray  on  problems  with  large  memory  requirement. 


i.e.  around  350K. 


I 


3 

PROGRAM  MAIN  76/76  CPT  = 1 CTM  4.6*433A  1 


1 PROGRAM  mAin  (IN  PIT,  OUTPUT,  PUNCH,  Tflprftr  OUTPUT  ,TAP£S  = INPI|T» 

01 V£NSION  XOATaiO,!!!)  ,Yt  (35)  ,*2(135)  ,£XPJ3(  16,16)  ,YA  (35)  • 

«EI  (16) ,EJ(96)  ,EK  (16)  , 

S£XP0N(35) , EXOONC 171 , Y3 (17) 

5 REAL  COSY  (24576)  ,SINVf?457M  ,SN1  (*4576  \ , V 2 ( 1 536  ) , jn  (?U5  76)  , 

% JN It  2611 3) , IN A (54272) ,0£L  J (26112) , 31 ( t 6)  , *2 ( 16 ) , Y« (24576 ) , n ( 2C"3 I , 
YVC  (16) 

INTEGER  JNS(1536I , JNPI3372) 

C "'T T 93(26112) 

id  LOGICAL  9 3 ( 26112  ) 

LEVEL  2 , JN A 
LEVEL  2 , PEL  J , INI  ,YP 
LEVEL  2,C0SY,SINY,SNl 
Lc VEL  2 , SN2 , JNS 
15  LEVEL  2,03 

C0MM0N/GN/JGAUSS,X77  7 (21 

COMMON  /A/JNA 

COMMON  /R/  OLL J, JN1, Y9 

COMMON  /C/  COSY, <INY,SN1,SH2, JNS, n3 

21  NAM-LIST  / INSTP  / Y7CST,  03 3C  , AL E , G AM,  N-'  M 7 , Y 1 ES T , Y?iST , AL°  1 1 0 , OE Lp, 

» 02 2 C ,MUM1 , NUM2 , NC2, NO  3 

WRITE  (6,666) 

666  r0OM A T (1H1,5HINP))T) 

KE  AO ( 5 , I KSTP ) 

25  WRITE (6, T MS  T9) 

JGAUSS  = 0 

PUG  = 10.**(ALP11C/11. ) 

00  = o?2C**(.?5) 

RX  = (PllO/tSORT  (2,0  ) *001  1 ♦M4.0/3.C  ) 

3J  PTC  = SORT (2. 0 ) “PX** (.25) /PO 

O'LT  = OELP*PTC 

022  = 022C*0ELT 

Rll  = KX/OcLT 

0220  = P113*S0OT (022C/RX) 

■»5  R1 1M1  = 1 • /311 

ALPO  = ALF'OPLT 

TET  = l.C  - ALrO 

All  = 10.**( (ALPlin*GAM)/lC.) 

A 22  = P2’0 

4:  P?3J  = .5*PT3C/ALF 

A 3 3 = 2.  C*p  33C 

033  = 013C ‘O^L  T 
P£V1  = SORT (All  I 
nrV?  = SORT ( A 2? | 

45  0EV3  = SORP(Rll) 

0EV4  = SO®T ( A 33 ) 

0EV02  = SO°T (022 ) 

0£V03  = SORT (03 3 I 

YOUNT  = 1 

6)  I SAMP  = 1 

NSAMP  = 0 

jumpi  s :.c 

SIIUP2  = 3.G 

»UPP3  = 3.j 

55  OcLSn  = CELT**? 

PI  = 4,*ATAN(1.) 

«T2  = 2.t*PI 
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PkOOnAN  main 


7S/7*  Cp  T=  1 


r7N  A.f + 4??A 


S3 


55 


73 


75 


‘ 


r 


r 


40 


50 


5 1 


55 


36? 

7 1 


*** 


PTOLT  = PI/HPLT 
PINV  = 1.0/PT 
°I?OL  T = 2.3  *PiriT 
U1  = NUM1 
• 12  = NUM2 
U3  = NUM7 

IY2  = U2/P!23LT*SaPT(5C.*n22)*.5 

NT£RM  = TV2 

NTEPM1  = NTtPM  ♦ 1 

NTPM16  = NTE°M* 1 5 

NO  = NTPM1S  ♦ 1 

NT  = ?*NTPM1S 

NT 1536  = NT  ♦ 1535 

R55  = .5/P11 

Cl  = -.5/A22 

CM  = - • 5 / A 3 3 

ST  = -.5/All 

*♦♦*♦♦*♦***•♦  CP  ID  VI,  Y2  ANn  YA  *♦* 
EOGl  = Pl/lll 
EOG2  = PT0LT/II2 
00  4G  I = lfMIJMl 
X = T - 1 
x = x/ui 

Yl(I)  = -®T  ♦ X*PI2  ♦ "OG1 
CONTINUE 

00  5o  I = 1 . MU M2 
X = I - 1 

y = y/u2 

Y?(I)  = -PTOLT  ♦ X*DT 20L T ♦ EOG2 
CONTINUE 
DO  51  I - 1 . Iv? 

y =■  I 

X = X/U2 
Y?m  = x 
CONTINUE 

00  55  T = 1.NIJH1 

cosy  ( i ) = cosiYnm 
S I NY  (II  = SINlYKin 
CONT  T NUr 
00  3«3  T = 1.1* 

sun  = cosy<t)/pii 

S?III  = SINYID/Pll 
CONTINUE 

CALL  VP<<CP<SINY , STNY,iN,?u576,l6> 
CALL  VPPnP(CnSY, COSY, I*,? 4575,16 > 
Xp=.5*«0PT (A33) 

VY?  r ( NUM7  - 1 . :»/2.C  ♦ 1.3 
TV?  = Y V 7 
00  f>u  I = l.NUMj 
XX  = T - Y v 7 
YA  < I ) e Y 7[?T  * yp*xx 
Yc<n  = ''3i:sT*xn*xx 
CUNT  I MU" 

qy^'ANIC  £VPON- ••TTCLS 
Ip  I T Y2  .£0.  j»  CO  TO  153 
DO  15o  I = l.iv? 

DON  = PI  rLT*r*I2nL" 

k7 


PROGRAM  MAIN  76/76  0®T  = 1 FTN  4.6*4?7A 


US  EXDON(I)  r EX P ( -00N/02 ?* ( Y3 ( T ) *“ 2 ) > 

150  CONTINUE 

DO  152  I = 1.IV2 

EXPON(I)  = EXOON ( IY2*1 -T ) 

EXPON  (IY2*1*I»  = EXOONm 
120  152  CONTINUE 

153  EXPON (IY2*1 ) = .5 
IYY  = 2*1 Y2  ♦ 1 
LTERM2  = 3 

00  720  K = 1,16 

125  DO  720  I = 1,16 

XNUM  = { K - I|*XP  ♦ «LFOMVAfr»  - 1.) 

XNUM  = -.5/9??*XNUM**2 
EXP33(I,N)  = C.O 
IF  (XNUM  ,LT.  -27.1  GO  TO  7?C 
L 3 j EXP33»I,K>  r FXP(XNUM) 

720  CONTINUE 

L Tcpm  = 2 

LTRM16  = LTERM*16 
LTERM1  = LTERM  ♦ l 
1*5  LC  = L T°  M16  ♦ 1 

NS  = NT 15X6  *L  TE  °M  ♦ NC 

C NOT  ON  ORIGINAL  LISTING,  OUT  ON  ICAS-_  REPORT  LISTING 


1 = 0 

OO  339  < = 1,16 

140  00  339  N = 1,16 

00  J = NT£PMt,IYV 

1 = 1*1 

0(1)  = EXPON (J) *E*°?3  (N,*> 

330  CONTINUE 

L 45  ALOSS=A73 

ALOSSO  = AL  OSS 
X 3EST  = Y 3EST 
X3EST0=Y3EST 

c INITIAL  O^NSITV 

150  00  155  1=1,16 


XXX=ST*(Yi (T) -YiEfT)**? 

IF (XXX  ,LT.  -?7)  GO  TO  154 
fcI(TI =EXP(XXXI 
GO  TO  155 

155  154  FI(T)=J.O 

155  CONTINUE 

00  157  J= 1 , 96 

YYV=CL*(Y2( J) -V2EST) **2 
IF  ( Y YY  .LT.  -27)  GO  TO  156 
160  EJ (J) =FX° (YYY ) 

GO  TO  157 

156  EJ(M=G.3 

157  CONTINUE 

''O  169  <=1,16 

165  777  = CM*  ( YA  CM -Y*EST>  *•'» 

lr ( 77*  .LT.  -27)  GO  TO  «6« 
e.K(<)=EXD*777) 

GO  TO  169 
15“  tK(<)=3.3 

159  CONTTNU* 

TJ*  = 3 


43 


f»PO GRA*  MAIN 


74/76  OPTri 


•■TN  4.  6*433A 


00  163  * = 1,16 
00  16  j J = 1,96 

00  1 6 J I = 1,16 
I IK  = I J<  ♦ 1 
JN(TJK) =£*(*) *EI (I )*FJ(J> 
163  CONTTWII; 

‘ M«?ITEC6,999d  » JN 

999o  FORMAT  (1P6E14.M 


INTEG-R  At\P  6 NGMENT 


00  225  I = 1,26112 
93(1)  = • TRUE * 

226  CONTINUE 

T = G 

00  303  K = 1,16 
00  133  ) * 1,«6 

I = ▼ ♦ 17 

03(1)  = .FALSE. 

30 j CONTINUE 

00  320  K = 1,3071,2 
JN*(K)  = [X  - l ) *• 

320  INFOLD  = JNF(K) 

1=0 
J1  = 0 

00  332  K = 1,16 

00  332  J = 1,96 

I = T ♦ 1 

II  = Ji  ♦ M00<?3-( J-l)/6,16) 

JN5 ( I ) = II 
.11  = Jl  ♦ 3? 

332  CONT INUC 

00  733?  I = 1,17 

OELJ(T)  = 11. /12. 

OFL  J (T *17 ) = .76 
0£LJ(T*34)  = 7./12. 

OEL  J ( I *51 ) = 5./12. 

OEL  J ( I*63 ) = .26 
0£LJ(I*35)  = 1./12. 

7332  CONTINUE 

CALL  VPo0Dl(0rLJ)  •**•••♦♦**)))))>))))» 
CALL  VP®nPf«“L J, OEL J , 10 2 , ’6 j l Q ,13?) 

11  COWTINUE 
KOUNT  = 1 

CALL  GAUSS (JSE*0,PEVl,Ylp6T,  XI) 
X0AT(*0UNT»1)  r xi 
CALL  GAUSS ( JSE * C ,OEV?» Y2EST, X? ) 

CALL  GAUSS(  )S - "0 ,0EV4, Y3SST , X3> 
ACPS=cxO(X3-l. ) *C0S(X1 ) 

ASTN=;X°(X3-1,  )*SI*1(V1) 

CALL  GAUSS  ( JSt  i'' ^ EVT , ACO** . 7 « » 

CALL  GAUE6(  )SECC,36V’,AST'!.7?)  . 

GO  TO  47) 

'*5:  CONTINUE 

XI  s >1  ♦ X? •9; L I 
X 0 A T ( XOUMT , 1 ) = Y i 

CALL  GAUSS)  )S'irO  ,OcVn2»  X?  »>  ?) 

X 3 = X 3*0  = T ♦ AL  c0 
CALL  GAUSS) JSCiO.OpV03.X3,<3) 


i e*4 


POOGRaM  ►'AIM 


7 6/76  Oc  T=  1 


c tn  u.  *«-43ia 


XOAT(XOUNT,5)=X3 
ACOS=tXP(X3-l. )*COS(Vl) 

ASIN=EXP(X3-1.  >*SINOU) 

CALL  GAUSS ( JSECO  »OFV?»ACOS,  ?1 ) 

CALL  GAUSS( JSEEO.OFVT, AStN,72) 

XP  = . 5*S0?T (ALOSS) 

XP=.S*AMAX1(.3C1 .SORT (A LOSS) ) 
XPO=.S*SORT(ALOSSO» 

LTE»*  = 0 
no  603  I = 1.NUM3 
XX  = I - YY3 
YA  CI»  =XT£STO*XX*XPO 
YC(I)  =X"»tST»XX*XP 
CONTINUE 
00  73 j X - 1,16 
DO  73C  I = 1,16 

XNUM=ALCP*  (YA(T)-l.)  *YC(X)  - Y fi  ( I ) 

XNUM  = -,6/rm*XNU*1**2 

EYP33 (I , X ) = C.O 

IF  ( X NUN  ,LT.  -27.)  GO  TO  73: 

FXP33  (T,  X)  = FXP(  XNU'*) 

CONTINUE 


00  34G  X = 1,16 
00  343  N = 1,16 

TEMP  = EXp  33 (N,X) 

00  340  J = NTEPMl.IYv 

1 = T ♦ 1 

343  0(1)  = EXPON(J)*TFM» 

470  CONTINUE 


SENEO=  FUNCTION 


CALL  SE00m(TI»'PIN) 

00  75u  0 I = 1,16 
P11TZ1=71*P11M1 
RllTZ2  = 72*Rlim 
SI (I) =P11T71*CCS (vi  (T) ) 
SP(I)=R11TZ?*STM(y1(I)) 
SKI)  = SKI)  ♦ S2(I) 


00  600  X = 1,16 

00  860  XX  = 1,16 

S2 (XX) =S1 (KX)*FXP(YA (X>-« . ) 

SN2  (XX ) = EXP ( S2 ( XX ) ) 

CONTINUE 

******  CALL  WP°0P ( SN2, 0 ) )))))))))))))))))) 
CALL  VpROP (SN2.SN2, 16, 1530,16) 

00  37C  xx  = i ,1636 

SMI (XX*  ))  r SN2(XX» 

CONTINUE 

f>0  ».»:  XX  = 1,16 

S2  (XX)  2-c55*FXP(V  A (X)  -1  , ) •"  f V A (X)  -1  , ) 
SN2  (<X ) = £XP(S»(XX)) 

CONTINUE 

********  CALL  VPROP(SM?,3)  ) I )))))))  M )))  ) 
CALL  VpROn  ( X'l?  » SN2  » 16 » 1 5 J * , 1 6) 

00  *<*£  XX  = 1,153* 

SM1(K<+J)  = SN1 (XX* P *SN2 (XX) 


PROGRAM  MAIN 


76/76 


0°T=1 


e TN  4.6*433 A 


’*‘0 


COMTTNU- 
J = J ♦ 1536 

continue 

»••**»»»•«»»«••  KATN  L00p  STARTS  •*** 
►**  CALL  0*)VXT0\/  (<*C2,3,KJNc»Q,ni3,Q,r'  INA) 
CO  707  KK  = It  24576 
JN ( KK) = JN ( KK ) *SN1 ( KK ) 

CONTINUE 
J = 1 

DO  991  K = lt3''72 
DO  992  I = 1,16 

JNA  ( J)  = JN<JNK(K)*I) 

J = J ♦ 1 
CONTINUE 
CONTINUE 

CALL  ttt  t K JNS  DC  U 

J = 1 

DO  903  K = 1,1536 
DO  994  I = 1,17 

JN1(J>  = JNA  (JNS(K)  +T| 

J = J ♦ 1 
CONTINUE 
CONTINUE 
IN1(26113>  = 0.0 
DO  9 j C KK  = 1,26112 

JMA(KK)  = JN1  ( K K 1 ) - JNl(KK) 

INA(KK)  = DEL  J ( KK ) * JNS  (*< ) 

JNl(KK)  = JN1 (KK)  ♦ JNA (KK) 

CONTINUE 

CALL  PRVEC ( 4M JN1  , INI) 

17  = 1 

DO  902  KK  = 1,26112 

IF  (.NOT.  93 ( KK) ) GO  TO  932 
JNA  ( T 7 | r JNl  (K*) 

JN 1 (17)  = JNA  (17) 

17  = 17  ♦ 1 
CONTI  NU17 

W=>IT:  (6,9999)  JNl 
J = 3 
I = C 

DO  oi 0 K = 1,16 

N = I ♦ NT°M1 6 

DO  511  KK  = 1,1536 

JNA ( KK  *N ) = JN 1 ( K K + J ) 

CONTTNU- 

DO  512  KK  = 1 .N-rp^lF 

JNA (KK*I ) = JNA (KK, 1*1536) 

CONTINUE 

DO  513  KK  = 1 , N 7 C M 1 6 

JNA  (\'*1526*KKI  = JN 1 ( < X*  I ) 

CONTINUE 
I = J ♦ 1536 

I = T ♦ NT1CJ6 

CON  TT  NUr 

CALL  P-V"P(4MJNA  , INA) 

N r C 

T l = r 

■ * * 


a «r 


PROGRAM  MAIN 


76/76 


op  r=i 


ptn  u.o+ltih 


JK  = 1 

30  -Od  I = 1,16 
11=0 

no  701  K*  = 1,1516 
JNt (N*KK)  5 0.0 
701  CONTINUE 

no  69 J K = 1,16 

J1  = NS  ♦ 11  - 1 
J2  = NS  ♦ II  - 1 
DO  683  J = 1 »NTEpHl 
no  701  KK  = 1,1516 

JN(KK)  = JNA  ( KK* J1 ) ♦ JN  A ( KK*  J2 ) 
JN(KK)  = JN  * *3(  J*> 

JN1(N*KK)  = JN1(N*KK)  ♦ PI(KK) 
7C3  CONTINUE 

JK  = JK  ♦ 1 

J1  = J1  ♦ 16 

J2  = J?  - 16 

600  CONTINUE 

693  Il=Il*NT1536 

N = N ♦ 1536 
700  CONTI NUe 

CALL  PPVEC ( 4H JNIT  , JN1 ) 

C MOITE  16,9998)  JN1 

CNORM  = SUMLOGCJN1, 26576) 

IF  (CNC°N  .LT.  l,i-20)  CNOc*«  = 1.0 
CNO^H  = 1 • /CNOc  M 
OO  713  KK  = 1,26576 

JN  IKK)  = CN0°9*JN1 IKK) 

JNA  ( KK)  = COSMKK)  * IM(K<) 

713  CONTTKUE 

CHAT  = SUMLOGJ JNA, 26976) 

OO  ’ll  KK  = 1,26576 

JNACKK)  = STNTJKK)  • JN(KK) 

711  CONTINUE 

SHAT  = SUKLOGJ JNA, 26576) 

CXMAT  = ATAN2CSMAT ,CHAT) 

J = 0 

90  361  K s l,lf 

90  77C  KK  = 1,1536 
V*?  J KK*  J)  =*C(K) 

770  CONTINUE 
J = J ♦ 1536 

163  CONTINUE 

OO  77 1 KK  = 1,26576 

JNA(KK)  = Vn (KK ) • JN  CKK ) 

771  CONTINUE 
X3ESTO=X3EST 

X1EST  = SUHLOGI JNA ,26576) 
no  771  KK  = 1,26576 

JNA  (KK)  = JNA  <«^K)  *T9(<^I 
77 1 PONTIMJE 

ALOSSOrALOSE 

ALOSS  = EUNLOG (JNA ,2 65 76) 

ALOES  = ALOSS  - XlESi'Xl-TST 
ALCSS=AMAX1 (ALOSS, l.E- 18) 

C «»»»*«•*•«'»*•*#•**••  LrJ0P  rNos 


47 


PROGRAM  MAIN 


76/76  CP  T = 1 


r TN  4,  p«-41»A 


201 

89o1 


SOS 


1493 

1499 

1530 

15bl 


169  3 

169? 

1703 

160  i 


2230 

fc  93 -i 
967 1 
1511 


CALL  SECOND (T IPO  LT1 
TNLP  = TI MOUT  - TIMEIN 

WRITE  16, 2C1)  KOUNT  t x 1 » X?»  X * » SH  AT  * CHAT  , Cx  HA  , X x^ST.  2L  OSS 
cO®MAT  I I5,lX,lP3£14.6,-X,lB?£14.6,4Y,10'»flL.6  » 

WRITE ( 6, 383G  > TNLP 
PCRPATJ  lprl 2 • 6 ) 

IF  (KOUNT  ,iO.  N02  ) CO  TO  5JS 

XOAT (KOUNT, 2»  =CXHAT 

XO  AT (KOUNT, 3>=ALOSS 

XC  AT  ( KOUNT  *4) = X 3EST 

KOUNT  = KOUNT  ♦ 1 

GO  TO  450 

CONTINUE 

SUMP  =3.? 

SUMC  = 9.0 

X 0 AT ( KOUNT . 2 1 = CXMAT 
XOAT (KOUNT. 3)  = ALCSS 
XOAT  (KOUNT, 4»  = XXEST 
DO  15C1  I = 31.N02 

XO  * AOS ( XOAT  ( 1 , 1 > - X()AT  (1,2)) 

CONTINUE 

IF  (XO  .GT.  PT|  GO  T0  1499 
CO  TO  1533 
XO  = XO  - PI? 

GO  TO  1499 
SUPP  = SUM®  ♦ xO*xn 
CONTINUE 
H = N02  - V. 

SUMP  = EUMO/H 

XNSAMP  = NS AMP 

X A A r XNSAMP  ♦ l.C 

SUM°1  s (S'JM»  ♦ XNcA*'P»S'|MOl  »/XAA 

OSUmoi  = ALOG1C  (S'JMP1»*13.9 

DO  16CI  T = Jt ♦ NO? 

X0=A9S(X0AT (I ,51-XOAT ( T.4I) 

CONTINUE 

IP  (XO  . GT.  °I»  CD  TD  1699 
GO  TO  1790 
XO  r vo  - PI? 

GO  TO  1699 
SUMC  = SUMC  ♦ *0*XD 
CONTINUE 
SUMC  = SUMC/H 

SUMO?  = (SUMC  ♦ XNSAP.P*SUMP?»/yAA 
OSUMP?  = ALOG1C (SUPP?»*1J.S 

wo  ITE  16,1511 ) NSAMP.SM^oi  .DSUMOl.SU-P?  tDSi'“02 

NSAMP  = NSAMP  ♦ 1 

IF  (ISAMP  ,EO.  UOX|  Gf,  T O 2231 

ISAMP  = ISAMP  ♦ 1 

CO  TO  71 

CONTINUE 

STO° 

cO?MAT (1M  ,?»X£1U.7,/,1M  »» 

PO“MAT(lM  , I?) 

c OPM AT ( Tl 3 • 1°4E 14 ,6 » 

ENP 
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1 


su«routi  n-:  vprop  76/7*  opt-i 


FTN  4.6*4334 


1 


5 


1 3 


SUBROUTINE  VPPOD  (cROM*  tO*ino.TrNr«IN,'l 
01 MENS I ON  FROM ( 1 ) , TO (11 

lev=:l  2, from, to 

00  10  I = IGO,  IENO.TN'' 

PO  22  J = l.TNC 

TOCT+J)  = FPOM(J> 

2 2 CONTINUE 

C 

11  CONTINUE 
RETURN 
C 

"NO 


SYMBOLIC  reference 

M£P  (R=3» 

ntrv 

POINTS 

OEF  LINE 

P.LFEP 

ENCES 

3 

VPPOP 

l 

n 

A 3I • BL  ES 

SN  TYP- 

o r 

LOCATION 

(J 

FROM 

°"AL 

ARRAY 

F.P. 

REFS 

•> 

T 

* I 

36 

I 

INTEGER 

R-FS 

6 

OEFINcP 

*•  j 

0 

TENO 

integer 

F.o. 

RcrE 

4 

TEPTNED 

« I 

A 

ir.o 

INTEGER 

F.P. 

srrc 

4 

0EFINEP 

” I 
1 

0 

INC 

INTEGER 

P.P. 

REPS 

4 

5 

PEPIME 

JT 

J 

INTEGER 

arc  5 

2*p 

DEPINPD 

c I 

9 

TO 

PEAL 

ARRAY 

P.p. 

PfFS 

•» 

3 

pefim- 

TAT-  M 

i NT  LAB 

rLS 

B£F  line  refe»e 

NCr  S 

3 

10 

B 

4 

0 

23 

7 

5 

nCPS 

LA«£L 

I NOP  a 

FROM-TO 

LENGTH 

PRCPPPTI'S 

• • 

20 

13 

• I 

4 9 

15" 

MOT 

INNE  ■» 

29 

23 

I 

9 7 

4R 

INST  ACM 

TATISTICS 

PROGRAM  LENGTH  43 
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— : m 


FUNCTION  SUMLOr.  7b/7G  0°T  = 1 


rtfj  u,  b«-43TA 


10 


c 

c 


FUNCTION  SUMLOO(A,N» 
OlKcNSTON  A(ll 
LEVEL  2, a 
SUMLOG  = G.J 
00  10  I = 1 • N 

SUPLQG  = S'JMLOG  ♦ »(I) 
12  CONTI  MIT 


RETURN 

run 


SYM30LTC  ’►:c‘i»£NCF  UAP  (E  = 3) 


Entry 

POINTS  OEF  LINE 

ref-ounces 

4 

SUMLOr,  1 

b 

VAPIA3LES  SN  TYPE 

RELOCATION 

0 

a DE  AL 

ARRAY  F,o. 

orps 

7 

7 

23 

I integer 

REPS 

G 

PEFTNFO 

0 

N INTEGE® 

• 

c. 

• 

u 

REFS 

G 

OEFIMEO 

17 

SUKLOG  PEAL 

RCCS 

G 

defined 

ST  AT£  M 

ENT  LABELS 

Oi_F  LIME  PtFF.P 

ENGFS 

G 

10 

7 c 

LOOPS 

LABEL  INOFv 

FROM-TO  LENGTH 

PRO°FRTTrS 

12 

10  I 

G 7 l*R 

TNSTAC* 

STATI*?T  TCS 

?®OGRAM  LCNGTM  Pin  17 


smPouTiN-  gauss 


76/76 


OPT=l 


CTN  4.6+43TA 


1 SUBROUTINE  GAUSS(JS*S‘D,XM,V) 

OIMcMSTON  NST (3) 

COMMON  /RN/  Nl,N2,N?,Hr»Tl,T2.T-» 
COMMON  /GN/  J,  XR(2» 

5 IF  (J)  13,  10,  20 

10  J = 2 

THOOT  = d.*ATAN(l.  ) 

NST(l)  = 1600 
NST(2>  = 2329 
13  NST ( 3 ) = 1297 

X R ( 1 ) = oNNr(MST,H 
GO  TO  35 


20 

GO  TO 

(30,43),  J 

70 

J = 2 

15 

XP(1) 

= RNNP CNST  ,3  ) 

35 

XR  (?) 

= PKNP (NST  ,u  ) 

XI  = 

SORT (ARS(-2.*AL00(X3(1> > > > 

XR  (2) 

= T WOP I *Xe  ( 2 ) 

XP  (1) 

= X1*SINCXR(2) ) 

?0 

XR  (2) 

= Xl*COS (XR(2) ) 

X = XO(1I»SO  ♦ XM 
RETURN 


43  J = 1 

X = XP  (2)  *SD«-XM 
25  R^TIJON 

ENP 


CARO  NR.  SEVERITY  DETAILS  DIAGNOSIS  OP  P^O^LIM 

13  1 AN  IP  STATEMENT  m;y  BE  MOR r rPPICIFNT  THAN  A 2 OR  3 ORAf 


SYMBOLIC  PcFPPZNJF  MAP  (=>=3) 


Entry 

POINTS 

OSF  LINE 

P'PENPFS 

3 

MUSS 

1 

??  25 

V A~IA  7wES 

SN  TYP" 

pflocatton 

0 

J 

INTEGER 

GN 

PEPS 

4 

5 

3 

JS 

INTEGER 

•UNUSEO  P.°. 

"EFIM?" 

1 

3 

mp 

INTEGER 

PN 

orcS 

3 

77 

NST 

integer 

A PR  A Y 

9-f9 

, * 

> 

11 

0 

N1 

TNTEG^o 

CN 

ore  v 

3 

1 

M2 

INTEGER 

f N 

arc  r 

» 

? 

N3 

INTEGER 

f N 

R : P “ 

3 

3 

SO 

R'AL 

P 

or  e t; 

2 « 

7*. 

TWOPI 

er  ®L 

REP' 

1 A 

O r P I N p p 

4 

T 1 

AL 

PU 

5.Tf 

3 

O 

T? 

PEAL 

PM 

REPS 

3 

6 

T 3 

c*  AL 

PN 

3.-CC 

3 

51 


FUNCTION  PNNF 


76/7* 


OPT=l 


c TN  4.6*43.3A 


1 


5 


13 


1*5 


?0 


?5 


TO 


FUNCTION  PNNF (MS »HOOc ) 

DIMENSION  NC  ( 3 ) , NS ( 3 ) 

COMMON  /»N/  Ni,N?,N3.MO,Tl,T2,T3 
DATA  Ml, M2, M3  / -**2  3 , uj  j 6 , ?P  J 3/ 

IF  («OOE>  10,  100,  1C 
10  N 1 = NSlll 
M2  = NS (2) 

N3  = NS<3> 

T 1 = 2.**(-12> 

T2  = 2 • **  f-24) 

T 3 = 2. **(-36) 

MP  = 2**12 
ICO  < = N3  *M  3 
<0  = K / mp 
NCI  = K - (CO*MP 
K s N3*M2  * N2*m3  * KM 
KO  = X / MP 
NC2  = K - KO *MP 
K = N3*N1  ♦ N2*M2  ♦ N1*M3  ♦ 

<0  = X / MP 
NC  3 - K - <n*MP 
N1  = NC3 
N2  = NC2 
N3  = NCI 
XN1  = N1 
KN2  = N2 
XN3  = N3 

RKMF  = XN1*T1  ♦ *N2*T?  ♦ XN  3*  T T 

RETURN 

“NO 


SYMBOLIC  R£F ERENCc  MAP  (Pr3) 


EN  TRY 

POINTS 

0£F  LINE 

REFERENCES 

4 

®NNF 

1 

25 

\lt°  IA®LES 

SN  TYPE 

REwOCA  TION 

63 

INTEGER 

orc5 

1 4 

1 K 

1 

4 

OEFiN^n 

1 ’ 

i* 

1 

64 

•CO 

INTtGtR 

3TrS 

15 

IF 

i 

occin-;p 

14 

17 

2 

0 

MODE 

INTEGER 

F.p. 

®EFF 

5 

OEFIMEO 

3 

MO 

INTEGER 

°N 

Dre^ 

3 

14 

1 

0:-FTN"0 

12 

56 

“1 

INTEGER 

REF'; 

1R 

OEcINEn 

57 

TNT-GE® 

R r F c. 

\ 6 

1® 

0 " f T N 

60 

M3 

INTEGER 

®-rr 

l T 

1 * 

1 

73 

NC 

INTEGER 

•IINOrc 

; 

f 

65 

NCI 

INTEGER 

arc  •? 

? •* 

O :FTN"n 

1 

66 

NC2 

integer 

R «,  F - 

•>  , 

0_FINPr 

1 

6T 

NC  3 

integer 

a-r 

a a 

O ?!  F T N f " 

a 

5 

Ni 

INTEGER 

AROflv  F.P, 

O.-FG 

? 

6 

3 

Ml 

INTE  G£R 

PN 

C rr  r; 

3 

1® 

2 

52 


SURaOUTIN"  PPVEC 


76/  76 


0PT  = 1 


ptm  4.6*-*T3A 


1 SUBROUTINE  PRVFC JLAPTL, VEn 

C PRINT  SSL FCTEO  VECTOR  COMPONENTS 
INTcGtP  LAT-L,OIM12,COUNT 
PEAL  VEC(1» 

S LEVEL  2.VEC 

OATA  01-12, COUNT/1R36,  J/ 

COUNT  = C0IJNT*1 

C WRITCCS.SB)  FOUNT,  L £ S-L , 

C ♦ VrC(0THlP*7  ♦ H,  VEC(OTN12‘7*7S0  J , 

1J  C * VEC(niM12*7M148) 

C 99  F OcNAT ( 1 1 N PR,  ENTPY  ,IB,9H  AT  cNt,  ,A4, 
C ♦ SE14,7| 

Rc  TU°N 
ENO 


SYMBOLIC  REFcRTNCE  NAP  t R=  3 ) 


:ntpy 

POINTS 

OE F LINE 

p^ffpENOpS 

3 

PRVEC 

l 

1’ 

/APIABLES 

iN  TYPE 

RELOCATION 

10 

COUNT 

INTEGER 

REFS 

3 

7 

OTFTNf 

▼ 

01.112 

INTEGER 

RECS 

3 

0EFINEO 

f 

0 

LABEL 

INTEGER 

♦ IINUSEO  F.p. 

REFS 

3 

OccTN- o 

1 

c 

VcC 

PEAL 

ARRAY  F.P, 

err  s 

4 

K 

0 E F I N r 

STATISTICS 


I 

■ 

I 

I 

I 


» 

> 
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CDC  Star-100 


The  code  for  the  3“D  phase  demodulation  problem  was  a natural 
extension  of  that  for  the  2-0  problem  described  earlier.  The  model  for 
the  problem  is  described  in  £l]  . In  particular  the  problem  pushed  the 
capacity  of  Star  to  its  limit  as  the  density  now  was  represented  as  a 
25.000  word  vector  which  because  of  the  algorithm  structure  required  close 
to  the  65,000  word  vector  limit  of  the  machine.  This  code  was  not  used 
for  Monte  Carlo  production  runs  because  of  computer  time  limitations,  but 
as  a check  on  the  accuracy  of  the  assembly  code  for  the  AP120B  code  of 
the  next  section. 
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C0001 

00002 


00003 

00009 

0000  b 
00006 
00007 
00006 

00009 

00010 

00011 


00012 

00013 

00019 

0001b 

00016 

00017 

00018 

00019 

00020 

00021 

00022 

00023 

00029 

0002b 

00026 


00027 
0002  8 

00029 

00030 

00031 
00JU-2- 
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PROGRAM  MAIN!  INPUT*  OUT  PUT  » PUNCH  , UN  I T6  • OUT  PUT  , 'JN  I T 5 • I NPUT, 

X UNIT10-SEED) 

U I ME NS  ION  XDAT(130»10)»XH4T(9)*Yl(3b),Y2(13b), 
*EXPON(3b)»EXDON(17),Y3(17),PNF(3»3)  ,YA(35)»EXP33(16,16), 

♦ U(3»3)»P8AR(3»3)»PN(3»3)»AN(3)»F(3»3),?DJMMY(3»3),;>DUNY2(3»3) 
CUMMON/GN/ JGAUSS,XZZZ (2) 

REAL  COSY( 29576) , SI  NY (29576 ), SN1( 29576 ), SN2 1 1536), JN( 29576), 

♦JN1 (26112), JNA( 59272 >»DELJ (26112 )*Sl(i6) . S2 ( 16 ) * Y8( 29 576 ) * D (2000 ) 
REAL  YC ( 16 ) 

INTEGER  JNS ( 1536), JNF ( 30  72  ) 

INTEGER  OPS  EE  0,SDN0RM,  SO  WR  T , S 0RDWR  , SOS  T AR  , S DR'JN,  SOS  A VE,  SOREST 
BIT  B 3( 26112) 

DESCRIPTOR  0B»KJNF,DJNA,KJNS»DJN1,DC 

DATA  SDNORM,SDWRT,SORDWR,  SOS T AR, SORUN * SOS A VE * SORE  ST 
X / 0 , 1 » 2 , 1, 2,3,9/ 

NAMELIST  / 1 NS  TR / Y3E S T, 03 3C , ALF , GAM ,NUM 3, 

X YlcST, Y2EST, ALP  110, DE LF , 022C , NUM1 , NUM2, N02, N03, OPSEED, 

X IPRIN 

ASSIGN  DB,JN(l;lb) 

ASSIGN  KJNF, JNF( 1J3072) 

ASSIGN  DJNA,JNA( 1 ; 9 9 1 52  > 

ASSIGN  KJNS,JNS( 1*1536) 

ASSIGN  DJN1,  JNK1J26112) 

ASSIGN  DC , JNA ( 1 ; 17) 

CALL  Q3CL0CKS( IOATE, ITIME ) 

WR I TE ( 6, 992 ) IOATE, ITIME 

992  FORMAT ( ' COMPILE  VERSION  5-ld-77,  NEW  FILT39', 

X DATE, TIME  - «,2A12) 

JGAUSS-0 

C SET  SEED  DEFAULT 

OPSEEU  > SONORM 
JSEEO  • SORUN 
IPRIN  ■ 2 

C63  FORMAT* 9F10.5, 15 ) 

RE  AO ( 5, INS TR ) 

WR I TE ( 6, INS  TR  ) 

C 69  F0RMAT(SF10. 5,915) 

C 

IF (JPSEEO  .EQ.  SDRDWR)  GOTO  31 

CALL  GAUSS ( SOSTAR,  T E Ml , TE M2, T E M 3 ) 

GOTO  32 

31  CONTINUE 

CALL  GAUSS (SOREST,  TE Ml , T EM2, TE M3  ) 

32  " CONT I NUE 
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09/27/78  20  s 40 

00033 

P110-10.** (ALP110/10. ) 

00034 

QQ«Q22C**(.25) 

00035 

RX-IP110/( S0RT(2. 

0 ) *Q0 ) )*♦( 4. 0/3.0) 

00036 

FTC»SQRT(2.0)*RX**( .25) /QQ 

00037  _ 

DELT-DELF*FTC 

00038 

Q22-Q22C*DELT 

00039 

Rll-RX/OELT  

00040 

R11M1  ■ 1./R11  . 

00041 

P223»P110*SQRT(Q22C/RX) 

00042 

ALF0»ALF*0ELT 

00043 

BET-1. O-ALFO 

00044 

All-10. *+(< ALP110*GAM)/10. ) 

00045 

A22-P220 

00046 

P330-0.5*Q33C/ALF 

00047 

A33-2 .0*P330 

00048 

Q33-Q33C+DELT 

00049 

DE VI « SORT (All ) 

00050 

0EV2-SQRT ( A22 ) 

00051 

DE  V3- SOR  T ( Rll  ) 

00052 

DEV4- SORT ( A33  ) 

00053 

0EV02-SQRT(Q22) 

00054 

DE  V03-S0RT ( 033 ) 

00055 

KOUNT-1 

00056 

I SAMP  - 1 

00057 

NS  AMP -0 

00058 

SUMP1-0.0 

00059 

SUMP2-0.0 

00060 

SUMP3-0.0 

00061 

DELSO-DELT  **2 

00062 

PI »4.*ATAN< 1. ) 

00063 

PI2-2 .0*PI 

00064 

PIDLT-PI/DELT 

00065 

PINV-l.O/PI 

000O6 

PI2DLT-2.0*PIDLT 

00067 

U1-NUM1 

00068 

U2-NUM2 

00069 

U3-NUM3 

00070 

IY2-U2/PI2DLT*SORT< 50.0*022) *.5 

00071 

NTERM-IY2 

00072 

NTERM1-NTERM+1 

G0073 

NTERM16-NTERM*16 

00074 

NC-NTERM1641 

00075 

NT-2*NTERM16 

00076 

NTA1536-NT*1536 

00077 

R55-0.5/R11 

SOURCE 
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00076 
00379 
00080 


00081 
00082 
00083 
0008  A 
00083 
00086 

00087 

00088 

00089 

00090 

00091 

00092 

00093 
0009A 
00093 

00096 

00097 

00098 

00099 

00100 
03101 


00102 
00103 
0010  A 
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CL— 0.5/A22 
CM— 0.5/A33 
SI— 0. 5/All 

C ***t********««**GRI0  Y1>Y2  AND  YA 

EDG1-PI/U1 
EDG2"°IDLT/U2 
00  AO  I »1 * NUM1 
X-I-l 
X-X/Ul 

AO  Yl( I ) — PI*X*PI2*EDG1 

00  50  I ■ 1 » NUM2 
X • I — 1 
X-X/U2 

50  Y2( II — PIDLT*X*PI2DLT*EDG2 
DO  51  I-1.IY2 

X-I 

X-X/U2 

51  Y3( I ) *X 

DO  55  I »1»  NUM1 

C0SY(I)-C0S(Y1(I)  > 

55  S I NY( I ) aS I N ( Y1 ( I ) ) 

S1(1;16)»C0SY(1;16) /R 11 
S2(l;l6)«SINY(iJ 16) /R 11 
CALL  VPRJP ( SINY# 1 ) 

CALL  VPROP (COSY* 1 ) 

C BEGIN  NEW  SAMPLE  PATH 
71  XP-0.5*SQRT(A33) 

YY3a(NUM3-i.0)/2.0*l,0 

IY3-YY3 
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MAIN 


00105 


00106 


00107 

00108 

00109 

00110 


00111 

00112 

00113 

0011A 

00115 

00116 


IF ( IPRIN  .GE.  2) 

X WRITE ( 6»981 ) 

FORMAT ( • 1 KQJNT»X1#X2»X3»  Z1 »Z2* 

X /•  CXHAT»X3EST*AL0SS#  TNLFM 

DO  60  I al»  NUM3 
XX* I-YY3 

YCC I ) aY3EST*XP*XX 
YA( I l-Y3EST*XP*XX 

********************  DYNAMIC  EXPONENTIALS 
IF  (IY2.EQ.0IG0  TO  153 
DO  150  I *1# I Y2 
D0N»PI0LT*PI20LT 

EXDON( I )-EXP(-00N/Q22*( Yl( l )**2  ) ) 

DO  152  I-1»IY2 

EXP ON ( I ) «E  X DON ( IY2  + 1-I ) 


♦♦♦♦♦♦♦♦**a************ 
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00117 
0011b 

00119 

00120 
00121 
00122 

00123 

00124 

00125 

00126 

00127 

00128 

00129 

00130 

00131 

00132 

00133 

00134 

00135 

00136 

00137 

00138 

00139 

00140 

00141 

00142 

00143 

00144 

00145 

00146 

00147 

00148 

00149 

00150 

00151 

00152 

00153 

00154 

00155 
00166 

00167 

00158 

00159 
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152  EXP(JN< IY2+1+1) -EXDONl I > 

153  EXP0N(IY2*l>-0.5 
IYY«2*IY2*1 
LTERM2-0 

00  720  K-1,16 
00  720  1-1*16 

XNUM- ( K — I j*XP*ALFD* ( Y A ( 11-1.) 

XNUM»-0.5/Q33*XNUM**2 
EXP33(I»K)-0.0 
IF(XNUM.LT.-27.)G0  TO  720 
EXP33(I*K)»EXP(XNUM) 

720  CONTINUE 
LTERM-0 

LTERM16-LTERM+16 
LTERM1-LTERM*1 
LC-LTERM16+1 
NS-NTA1536UTERM  + NC 
1-0 

00  339  K*1 * 16 
00  339  N»1,16 
00  339  J-NTERM1»IYY 
I-IM 

339  DU>-EXP0N(J)*EXP33(N»K> 

ALOSS  -A33 
ALOSSO-ALUSS 
X3EST  » Y3EST 
X3EST0  - Y3EST 

C ♦♦**#*♦*****♦++*♦♦*♦**♦♦**♦*  INITIAL  DENSITY  ******♦*♦**♦**•**♦♦*. 

IJK-0 

DO  160  K» 1 » 16 
ZZZ»CM*< YAIK)-Y3EST>**2 
00  160  J ■ 1 » 96 

YYY«ZZZ*CL*(Y2(J >-Y2£ST)**2 
00  160  1-1*16 
I JK-I JK*1 

XXX  » Y YY*S I * ( Y1 ( I I-Y1EST ) **2 
IF(XXX.LT.-27. IGO  TO  159 
JNtlJiO-EXP(XXX) 

GO  TO  160 

159  JN( I JK ) -0. 0 

160  CONTINUE 

C *♦*♦******♦**♦*♦+*  INTEGER  ARRANGEMENT  ***********+***♦*******♦♦* 

DO  225  1-1*26112 
225  BSm-b'l1 
1-0 
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00160 

00  300  K > 1 , 16 

00161 

00  300  J-l»96 

00162 

1-1*17 

00163 

300 

B3<I)-8»0» 

0016  A 

DO  320  K-l, 3071,2 

00165 

JNF ( K j ■ ( K-l ) * 8 

00166 

320 

JNF(K*1)-JNF(K>  ” 

00167 

1-0 

00168 

Jl-0 

00169 

DO  332  K-l, 16 

00170 

DO  332  J-1,96 

00171 

1-1*1 

00172 

Il-Jl*MbD<23-( J-1) /6,16> 

00173 

JNS ( I ) ■ 11 

0017A 

332 

J 1 • J1 *32 

00175 

DELJ(lil7i-li./12. 

00176 

DEL J ( 18} 17) >0*  75 

00177 

DEL J( 35;17) -7./12. 

00178 

DELJ(52;17)-5./12. 

00179 

DELJ(69;17)-0.25 

00180 

DEL  J ( 36;17)-1./12. 

00181 

CALL  VPR0P1 (DEL J ) 

00182 

11 

CONTINUE 

00183 

KOUNT-1 

0018A 

CALL  GAUSS (J SEED, DEVI, Y1EST, XI) 

00185 

XDAT(K0UNT,1)-X1 

00186 

CALL  GAUSS < JSEED, Dt V2, Y2ES T, X2 ) 

00187 

CALL  GAUSS (JSEED, DE VA, Y3E ST, X3 ) 

00188 

AC0S-X3*C0S(X1) 

00189 

AS  I N- X3*S I N ( XI ) 

00190 

CALL  GAUSS (JSEED, DEV3,AC0S»21 ) 

00191 

CALL  GAUSS(JSEED,DEV3,ASIN,Z2) 

00192 

GO  TO  A70 

00193 

A 50 

CONTINUE 

0019  A 

X1-X1*X2*DELT 

00195 

XDAT(K0UNT,1)-X1 

00196 

CALL  GAUSS(JSEED,DEV02,X2,X2) 

00197 

X3-X3*BET*ALFD 

00198 

CALL  GAUSS< JSEED, DEVQ3,X3,X3> 

00199 

XDAKKJUNT,  5)-X3 

00200 

ACGS-X3+C0S(X1) 

00201 

ASIN-X3*$IN(X1) 

00202 

CALL  GAUSS(JSEED,DEV3,AC0S,Z1) 

00203 

C 

CALL  GAUSS (JSEED, DEV3,ASIN, Z2  ) 

X P»  0 • 6* AM AX  1 ( >001, SORT (ALOSS) ) 

FORTRAN  Rl. 
0023* 
0020$ 

00206 

00207 

00208 

00209 

00210 
00211 
00212 

00213 

00214 

00215 

00216 

00217 

00218 

00219 

00220 
00221 
00222 

00223 

00224 

00225 

00226 

00227 

00228 

00229 

00230 

00231 

00232 

00233 

00234 

00235 

00236 

00237 

00238 

00239 

00240 

00241 

00242 

00243 

00244 

00245 
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XP-.5*SQRT (ALOSS) 

XP0-.5*SQRT(AL0SS0> 

C XP0-.5*AMAX1( «001*SQRT(AL0SS3) ) 

00  600  i -1 » NUM3  _ 

XX-I-YY3 

YA( I) -X3EST0*XX*XP0 
600  CONTINUE 

DO  730  K-l » 16 
DO  730  I-l>16 

XNUM--YAC I)*X3EST*XP+(K-YY3)-ALFD*(YA(  I )-l.  > 

XNUM--0»5/Q33*XNUM**2 
EXP331I* K)-0.0 
I F ( XNUil.LT  .-27.  )GQ  TO  730 
EXP33(I»K) -EXPCXNUM) 

730  CONTINUE 
1-0 

DO  340  K- 1 » 16 
00  340  N-1,16 
00  340  J-NTERMl, IYY 
I-I*l 

340  DC  I )»EXPQN( J) *EXP33(N#K) 

470  CONTINUE 

C I***********************  SENSOR  FUNCTION  ♦*♦♦♦♦*♦♦♦♦♦***•*#****##« 

CALL  Q3CL OC KS ( T # T T > 

R11TZ1  ■ Z1*R 11M1 
R11TZ2  • Z2*R11M1 
SI ( 1 5 16 ) ■ R11TZ1*C0SY(1;16) 

S2(l;16)  - RllTZ2*SINY(lil6) 

Sl( 1; 16) -Sl(l;i6)*S2( l;ib) 

J -1 

00  500  K-l» 16 

S2(l;16)-Si(l5l6)«'CX3ESTMK-YY3)*XP) 

SN2(l;16)-VEXP(S2(l;16);SN2(l;16>) 

CALL  VPROP ( SN2*0  ) 

SNl(J;1536)»SN2(l;1536) 

S2(l)161— R55*(X3EST*(K-YY3)*XP)*(X3EST«-(K-YY3)*XP) 

SN2C1 ;16)-VEXP(S2(1;16) ;SN2< l ; 16 ) ) 

CALL  VPROP ( SN2»0  ) 

SN1C j;1536l-SNl( J;1536»*SN2(1 51536) 

500  J ■ J*1 536 

C + + + **  + + * + 0*********  MAIN  LOOP OS  TARTS  *♦♦*********♦♦**♦****♦*♦♦*♦*> 

JN( lj 24576 >-JN( 1)24576 )*SNl( 1524570) 

CALL  Q3VXT0V(X*02,*0*KJNF#3#08»C*DJNA) 

CALL  Q8VXT0V(X,02,»0»KJNS*0»JC»0#DJN1) 

JNAC 1 526112 )-JNl (2)26112 )-JNl (1526112 ) 
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00246 

00247 

00248 

00249 

00250 

00251 

00252 

00253 

00254 

00255 

00256 

00257 

00258 

00259 

00260 
00261 
C0262 

00263 

00264 

00265 

00266 

00267 

00268 

00269 

00270 

00271 

00272 

00273 

00274 

00275 

00276 

00277 

00278 

00279 

00280 
00281 
00282 

00283 

00284 
00235 
00286 
00287 

00298 

00289 
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JNA(1;26112)-0£LJ(1»26112)*JNA(1;26112) 
JNl(l;26112)-JNl(l;26ll2)+JNA(l»261l2) 

CALL  PR VEC ( ' JN1  • » JN1) 

JNA< l; 24576 ) ■ Q8 VC MPR S ( JN1 ( l; 261 12 ),83< l; 26112 ); JN\ (l; 24576 J ) 
JN1I 1 J 24576 )-JNA II ; 24576) 

J-l  _ 

1-1 

00  510  K-l*16 
N»  I *NT5RM16 

JNA(N; 1536)  -JNK  J;1 536) 

JNA(I;NTERM16)»JNA(I+153o>NTERM16) 

JNA(N*1536»NTERM16)-JN1(J;NTERM16) 

J-J*1536 

I- I+NTA1536 
N-l 
Ii-0 
JK-1 

CALL  PRVECCJNAS  JNA ) 

OU  700  1-1*16 

II- 0 

JN1 ( N ;1536 ) -0*0 
00  690  K-l » 16 
J 1-NS* I 1 
J2-NS+I1 

00  680  J ■ 1 * NT  ERM1 

JN ( l; 1536 ) -JNA (Jl;l536)*JNA(J2; 1536) 
JN(1;1536)-JN(1;1536)*0(JK) 
JNl(Njl536)-JNl(N;1536)*JN(l;l536) 

JK-JK+1 
Jl-Jl+16 
J2-J2-16 
I 1 • I 1 +NTA1 536 
N-N+1536 
CONTINUE 

CALL  PRVEC('JN1T*»JN1) 

CNORM-SUMLGG(JNl) 

If (CNURM.L  T.1.0E-20 )C NORN- 1.0 
CNORM-l./CNOKM 

JN (l; 245 76 )-C NORM* JN1 (1; 24576) 

SHAT  • 0. 

CHAT  - 0. 

SUMSC  « 0. 

3-2-77 

00  751  1-1*16 
SUMSC  > 0. 


680 

690 

700 
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00290  00  729  J-l, 96  ] 

00291  00  729  K-l, 16 

00292  1 

00293  ITEMP  « 1 + 16*  ( J-l  H-l  336*  ( K-l ) 

0029A  SUMSC  ■ SUMSC* JN( ITEM? ) • j 

00295  729  CONTINUE 

00296  CHAT  ■ CHA T*S UhS C *C OS Y { I ) 

00297  SHAT  - SHAT*SUMSC*SINY( I ) 

00290  751  CONTINUE 

C JNA(lj2A576)-CQSY(l;2A576)*JN(l;2A576) 

C CHAT«SUMLOG< JNA) 

C JNA(1;2A576)-SINY(1*2A576)*JN(1}2A576) 

C SHAT«SUMLOG( JNA) 

00299  CXHAT-ATAN2(SHAT,CHAT) 

00300  J-l 

00301  DO  3A3  K-l, 16 

00302  YB( J;1536)-(X3EST+(K-YY3)+XP) 

00303  3A3  J-J+1536 

0030*  JNA(  1,2*576)  ■ Y8  ( 1»2*576)*JN(  1,2*576) 

00305  X3ESTO-X36S  T 

00306  X3EST  * SUML  OG  C JNA ) 

00307  JNA(1;2*576)-JNA( 1;2*576)+YB( 1,2*576)  j 

00308  ALOSSO-ALOSS 

00309  ALOSS-SUMLOG(JNA) 

00310  ALUSS-AMAXK ALOS S-X 3 E ST+X 3E S T , 1 . E-l 8 ) 

C ♦♦**♦*♦♦♦+*+♦+♦♦***++***♦+  MAIN  LOOP  ENDS  *********************** 

00311  CALL  03CL0CKS (TNLF,TT) 

00312  IHIPRIN  .GE.  2) 

X WRITE(6,201)K0UNT,X1,X2, X 3,  Zl»  Z2»  C XH A T,  X3E  S T, ALOSS 

00313  201  F ORMAT  ( 1H  , I 5 , IX , 1 P 3E 1 A . 6,  A X, 1 P2E 1 A » 6, AX , 1 P3E It . 6 ) 


0031 A 

I F ( I PR  IN  .GF.  2) 

X WRITE (6,6880) TNLF 

00315 

8880 

FORMAT ( 1H  , 1 P E 12 . 6 ) 

00316 

IF(K0UNT.EQ.N02)G0  TO  505 

00317 

XOAT( KQUNT ,2)-CXHAT 

00318 

XDAT(K0UNT,3)-AL0SS 

00319 

XDAT(K0UNT,*)-X3E$T 

00320 

KOUNT -KOUNT+1 

00321 

GO  TO  *50 

00322 

505 

CONTINUE 

00323 

SUMP-0.0 

0032  A 

SUMC-0.0 

00325 

XDAT( KOUNT, 2) -CXHAT 

00326 

X0AT(K0UNT,3) -ALOSS 

00327 

XDAT(K0UNT»*>-X3EST 
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00328 

00  1501  1-31, N02 

00329 

XD»  A8S  ( XD  AT  ( 1. 1 ) — X D AT  ( 1,2  ) ) 

00330 

1498 

CONTINUE 

00331 

IFUO.GT.PI  )G0  TO  1499 

00332 

GO  TO  1500 

00333 

1499 

XD«  XD-PI2 

00334 

GO  TO  1498 

00335 

1500 

SUMP-SUMP+XD**2 

00336 

1501 

CONTINUE 

00337 

H-N02-30 

00338 

SUMP-SUMP/H 

00339 

XNSAMP-NSANP 

00340 

XAA"XNS AM P+1.0 

00341 

SUMP1MSUMP  + XNSAMP+SUMP1 ) / X A A 

00342 

DSUMP1"AL0G10( SUMP1 ) +10.0 

00343 

00  1601  1*31,  N02 

00344 

XD-ABS (XUAT (I,5)-XDAT< 1,4) ) 

00345 

1698 

CONTINUE 

00346 

IF ( XO.GT • PI )G0  TO  1699 

00347 

GO  TO  1700 

00348 

1699 

X0-X0-PI2 

00349 

GO  TO  1698 

00350 

1700 

SUMC»SUMC+X0**2 

00351 

1601 

CONTINUE 

00352 

SUMC»S'JMC/H 

00353 

SUMP2-(SUMC+XNSAMP*SUMP2 )/XAA 

00354 

0SUMP2-AL0G10( SUMP2 )*10.0 

00355 

WRITE (6,1611) NS AMP, SUMP1, DSUMP1 , SUMP2 , DSUMP2 

00356 

1511 

FORMATdH  ,110, 1P4E  14*6) 

00357 

r 

NSAMP-NSAMP+1 

C OPTIONAL  SAVE  OF  SEED 

00358 

1 F ( (GPSEED  .EO.  SDWRT)  .OR.  (OPSEEO  .EO.  SDROWR)) 

X 

; CALL  GAUS S ( SOSA VE , TEM1, TEM2, TEM3 ) 

00359 

l 

I F ( IS  AMP  .EO.  NQ3 ) GO  TO  2200 

00360 

ISAMP  » ISAMP+1 

00361 

GO  TO  71 

00362 

2200 

CONTINUE 

C 


00363 

00364 


STOP 

END 


FORTRAN  R1.3  CYCLE  I BUILT  09/27/78  20:^0  SOURCE  LISTING 

00001  FUNCTION  SUNLOGU) 

00002  REAL  A< 26112 )» C ( 122 98 ) 

0000  3 C ( 1; 12288 ) «A( l; 12238  H-A <12209; 12288) 

00034  _ C(1;6144)-C(1;6144)*C(6145;6144) 

0000  5 C ( 1 ; 3072J -C ( 1 ; 30  72 ) +C  < 3073 ; 30  72  ) 

00006  C(l;1536)-C<l;1536)+C<i537;1536)  * 

00007  C(l;768)-C(l;76B)+C<769;763) 

00008  C <1 )304 > -C <l) 384 )*C< 333)384) 


00009 

00010 


00011 

00012 

00013 

00014 

00015 

00016 

00017 

00018 


C < 1; 192 )-C < 1) 192 )+C< 193)192) 

C(1;96)«C<1)96)*C<97;96) 

C(lf48)"C(lj48)+C(49;48) 

C(1;24)»C(1>24)+C(25;24) 

C<l;12)»C(l;l2)*C<13;i2) 

C(l;6)«C(l;6)+C(7;6) 

C(l;3)*C(l;3)>C(4;i) 

SUML0GaC(l)+C(2)+C( 3) 

RETURN 

END 


FORTRAN  Rl.3  CYCLE  I BUILT  09/27/78  20**0  SOURCE  LISTING 


00001 

SUBROUTINE  VPROP(A,I> 

00002 

REAL  A ( 2*5  76 ) 

00003 

IF(I.EQ.2)G0  TO  10 

0000* 

A(  17;  16) sA( l; 16) 

00005 

A(33i32)-A(l;32) 

00006 

A ( 65  ; 32  ) * A ( 1 ; 32  ) 

00007 

10 

A(97;96)-A(l;96) 

00008 

A(193;192)*A(ljl92) 

00009 

A(385;38*)>A(l;38*) 

00010 

A(769;768) »A( l;768) 

00011 

IF  ( I.EQ.O) RETURN 

00012 

A(1537;1536)«A(l*153b) 

00013 

A ( 3073*3072 ) ■ A ( 1 #3072 ) 

0001* 

A(61*5;61**)-A(l;61**) 

00015 

A( 122d9;12288)»A( 1; 12288) 

00016 

RETURN 

00017 

END 

1 


! ! 


FORTRAN  R1.3 
00301 

00032 

00033 

00034 
00005 
C0006 
00007 

00038 

00039 
00010 
00011 
00012 


CYCLE  I BUILT  09/27/78  20:40 

SUBROUTINE  VPRJP1U) 

REAL  A ( 261 12 ) 

A ( 103 5102 ) -A ( l; 102) 
AC205J204)»A(1;204) 

A(439»408) * A ( 1 ; 408 ) 
A(017;816)*A(1;816) 

A(  1633;  1632) *A( 1 ; 1632  ) 

A (3265)3264) • A l 1 ; 32 64  ) 
A(6529;6528)»A(l;6528  ) 
A(13057;13066)»A(l;13056) 

RETURN 

END 


SOURCE  LISTING 


FORTRAN  R1.3 

00001 

00002 
00003 

_ 00004 


00005 

00006 

00007 

00008 

00009 

00010 
00011 

00012 

00013 

00014 

00015 
00U16 

00017 

00018 

00019 

00020 
00021 
00022 

00023 

00024 

00025 


CYCLE  I BUILT  09/27/78  20:*0  SOURC 

FUNCTION  RNNF ( NS  * MOOE ) 

DIMENSION  NS ( 2 ) * NC(2> 

COMMON  /RN/  Nl,  N2,  MP*  Tl*  T2 
DATA  Ml*  M2 / 244  734*  158551/ 

MOUE-O  TO  CONTINUE*  OTHERWISE  RESTART 
INTEGER  NUMBER  NS ( 1 ) *2** 18 *NS t 2 ) 

IF  (MODE)  10*  100*  10 
10  Nl-NS(l) 

N2-NS ( 2 ) 

Tl-2. *♦ (-1 8 > 

T2-2.**(-36> 

MP»2**18 

RETURN 

100  DO  200  1-1*2 

GO  TO  (110*120)*! 

110  K-M2*N2 
GO  TO  190 

120  K-Ml*N2*i12*Nl*KD 

190  KD-rt/MP 

200  NC(I)-K-KO*MP 
Nl-NC (2 ) 

N2-NCI1) 

XNl-Ni 

XN2-N2 

RNNF-XN1*T1*XN2*T2 

RETURN 

END 


SOURCE  LISTING 


WITH 


FORTRAN  K 1 

.3 

CYCLE  I BUILT  09/27/78  20:*0 

03001 

SUBROUTINE  GAUSS ( JS»SD#XM#  X) 

0000  2 

DIMENSION  NS T ( 2 ) 

00003 

COMMON  /RN/  Nl»  N2»  MC»  Tl»  T2 

0000* 

COMMON  / GN/  J » XR ( 2 ) 

C 

r 

SELECT  RESTART#RUN#SAVE»RESTORE 

0030b 

L 

GOTO  (10*  20#  101#  2 6 1 ) # J S 

03006 

10 

J-l 

00037 

TWOPI  *8 • * AT  AN ( 1 • ) 

00GJ8 

NST (1 ) ■ 2**  73* 

00009 

NST ( 2 ) »158551 

00010 

NST ( 1 ) »1029*3 

00011 

NST(2)»18b6l7 

00012 

XR(1)»RNNF(NST#1 ) 

00313 

r 

RETURN 

L 

c 

RUN  (GENERATE  RANDOM  NO.) 

0001* 

20 

GO  TO  (30. *0)#  J 

COOlb 

30 

J *2 

00016 

XR(1)-KNNF(NST#0> 

00017 

35 

XK(2)-«NNF(NST#C) 

oooie 

X1«SQKT(ABS< -2. *ALUG(XR (!)>)) 

00019 

XR(2) ■TW0PI*XR(2  ) 

03020 

XR(1)-X1*SIN(XR(2  ) ) 

00021 

XR(2)»Xl*C0S(XR(2>) 

00022 

X»XR ( 1>*SD*XM 

00023 

RETURN 

0032* 

*0 

J-l 

0002b 

X»XR(2)*SD*XM 

00026 

r 

RETURN 

- 

w 

c 

SAVE  SEED 

0032  7 

101 

REWIND  10 

00028 

WRI TE ( 10#991 ) N1 > N2  # J # XR ( 2 ) 

00029 

WR I TE ( 6#99 1 ) N1»N2#J#XK(2) 

00030 

r 

RETURN 

c 

RESTORE  SEED 

00031 

201 

CONTINUE 

30332 

REWIND  10 

00333 

READ( 10# 991 ) NST(1)»NST(2), J#XR 

0033* 

WRITE ( 6# 991 ) NS T ( 1 ) # NST(2)»  J 

0003b 

TWOPI  • 8.*ATAN(1.) 

00036 

XR  ( 1 ) * PNNF(NST#1) 

00037 

RETURN 

i 


TING 


68 


BUILT  09/27/78  20:^0  SOURCE  LISTING 


FORTRAN  R1.3  CYCLE  I 


GAUSS 


991  FORMAT ( • RANDOM  SEEDS  • # 3 110» E28. lb  ) 
END 


00036 

00039 


1 


FORTRAN  R1.3  CYCLE  I BUILT  09/27/78  20S40  SOURCc  LISTING 

00001  SUBROUTINE  PR VE C ! L ABEL » Ve C > 

C PRINT  SELECTED  VECTOR  COMPONENTS 
00J02  INTEGER  L ABEL* DIM12* COUNT 

00003  REAL  VECll) 

00004  DATA  D1M12*C0UNT/L536*  0/ 

OOOOb  I F ( COUNT  .GE.  0)  RETURN 

00006  COUNT  ■ COUNT+l 

00007  WRITE! 6*99)  CGUNT,  LABEL* 

♦ VEC  !0IM12*7+1 ) * VEC!DIM12*7+760)»VEC(DI Ml 2*7+1148) 

00008  99  FORMAT!*  PR.  ENTRY  '»I5,»  AT  PNT.  '>A4> 

* 5E14.7) 

00009  RETURN 

00010  END 


[ 


11-3  The  AP120B  Fortran,  Assembly  Language,  Vector  Chalner 

By  referring  to  figure  1 the  structure  of  the  code  for  the  Monte 
Carlo  restartable  code  for  the  3D  phase  demodulation  becomes  clear.  The 
code  is  made  up  of  three  different  types,  Fortran  Code,  Assembly  Language 
API20B  Code,  called  as  a Fortran  Subroutine  Vector  Chained  AP120B  Code, 
which  is  the  concatenation  of  Assembly  Language  Codes.  The  restartable 
features  of  the  code,  the  current  Monte  Carlo  averages  are  written  to  a 
file  after  each  sample  path,  were  provided  by  Milt  Campbell.  This  program 
was  used  to  generate  the  statistical  data  provided  in  £2j  . The  time 
critical  convolution  loops  are  realized  by  the  assembly  codes  RLNLF.FSO 
and  STHIRD.FSO  which  convolve  over  phase  rate  and  amplitude  respectively. 
The  coding  of  these  loops  are  time  optimal  for  the  AP120B. 


THIS  FILE  CONTAINS  INFORMATION  ON  HOW  TO  RUN  EXCO. 

M.  CAMPBELL  (SYSCON  DESICN) 

OCTOBER  9,1978 

SECTIONS  ARE  PRECEDED  BY  A LINE 

##N 

WHERE  N IS  THE  NUMBER.  THIS  ALLOWS  EASY  ACCESS  VIA  THE  EDITOR. 
CONTENTS. 

MI-RUNNING  THE  PROGRAM 
M2-LOOKING  AT  DATA  FILES 
# ^3-RECOVERING  FROM  ERRORS 
M4-DATA  FILE  FORMAT 
M5-FORTRAN  SOURCE  FILES 
##6-COMMAND  FILES 


##1  RUNNING  THE  PROGRAM 

##1.1  THE  PROGRAM  IS  ON  FILE  EXCO.TSK  SO  IT  MAY  SC  RUN  AS  A NORMAL 
RSX-llM  PROGRAM.  ON  STARTUP  THE  PROGRAM  EXPECTS  THE  FILES 
'INITIAL. DAT'  AND  'RESTART.DAT'  TO  BE  PRESENT  AND  TO  CONTAIN 
THEIR  CORRECT  VALUES  (SEE  DATA  FILE  STRUCTURE).  'INITIAL.DAT* 
CONTAINS  DATA  CONSTANT  FOR  A RUM  AND  ONCE  ED ITT ED  TO  YOUR 
SATISFACTION  NEED  HOT  BE  MODIFIED.  'RESTART.DAT'  IS  DYNAMICALLY 
UPDATED  BY  THE  PROGRAM  AND  CONTAINS  THE  CURRENT  RESTART 
INFORMATION.  FOR  THE  INITIAL  RUN  OF  THE  PROGRAM  ONLY!, 

FILE  'RESTART. INT'  SHOULD  BE  COPIED  TO  'RF.START.DAT'  TO  ENSURE 
THAT  A RUM  OF  THE  PROGRAM  WILL  INITIALIZE  PROPERLY. 

#01 . 2 COMMAND  FILE  'NEWRUN.DAT'  IS  PROVIDED  TO  SET  UP  THE  DATA  FILES 
FOR  INITIATING  AN  EXGO  RUN.  IT  RENAMES  AMY  OLD  RESTART  FILES 
(WHICH  CONTAIN  FINAL  RESULTS  OF  RUNS)  TO  HE  'RESTART. OLD' , 
DELETES  ANY  EXISTING  BACKUP  FILES,  CREATES  AM  INITIAL  RESTART 
BY  COPYING  'RESTART. INT'  TO  'RESTART.DAT'  AN!)  EXITS.  THE  FILES 
ARE  NOW  READY  FOR  AN  'RUN  EXGO'  COMMAND. 


##1.3  PROGRAM  CTLXGO  IS  PROVIDED  TO  ALLOW  ORDERLY  SMUT  DOWN  OF  EXGO 
EXTERNALLY.  EXGO  USES  EVENT  FLAG  54  FOR  CONTP.OL.  IF,  AT 
THE  END  OF  THE  MAIN  LOOP,  THE  EVENT  FLAG  IS  SET,  EXGO  SHUTS 


DOWN  WITH  THE  DATA  FILES  SET  UP  FOR  RESTART. 

##2.  CETTING  DATA 

##2.1  RUNNING  VALUES.  THE  FILE  'RESTART.DAT'  ALWAYS  CONTAINS  THE 
RESULTS  OF  THE  LAST  TIME  THROUGH  THE  OUTER  LOOP  Or  EXCO. 

IT  IS  THIS  FILE  THAT  WILL  BE  USED  IF  EXGO  IS  INTERRUPTED  AND 
THEN  RESTARTED.  EXAMINING  'RESTART.DAT'  OULD  PROVIDE 
THE  LATEST  INFORMATION  ON  THE  STATUS  OF  FXG'J. 

THE  FILE  'BACKUP.DAT'  CONTAINS  THE  SAME  VALUES  AS  'RESTART.DAT 
BUT  FROM  THE  PREVIOUS  PASS  THROUGH  THE  OUT LOOP . THIS 
IS  THE  SECONDARY  RECOVERY  FILE  IN  CASE  THERE  IS  SOME  PROBLEM 
WITH  'RESTART.DAT'. 


##2.7  START  STATUS.  A N17W  VERSION  OF  'RUNSTAT.DAT'  IS  CREATED 
EACH  TIME  EXCO  IS  STARTED  AMD  ANYTIME  THE  PROGRAM  FAILS 


##2.3  EXAMINING  THE  FILES.  'RESTART.DAT'  AND  'BACKUP. DAT'  SHOULD 
BE  EXAMINED  ONLY  WITH  F.XGO  NOT  RUNNING,  SINCE  EXCO  WILL 
QUIT  (WITH  AN  ERROR  ON  'RUNSTAT.DAT')  IF  IT  CAN  NOT  ACCESS 
BOTH  FILES. 

'RUNSTAT.DAT'  HAY  BE  EXAMINED  AT  ANY  TIME  AS  A NEW  VERSION  IS 
CREATED  AS  NEEDED. 


##3.  RECOVERING  FROM  ERRORS. 

##3.1  IF  EXCO  ATTEMPTS  TO  IIEP  THE  RESULTS  OF  THE  LAST  TLME  THROUGH 
THE  OUTER  LOOP  ON  THE  FILE  'RESTART.DAT'  AKD  THE  RESULTS 
ON  THE  PREVIOUS  PASS  ON  'BACKUP. DAT*.  THE  OLD  DATA  IS  COPIED 
FROM  'RESTART  DAT'  TO  'BACKUP.DAT'  BEFORE  WRITING  THE 
NEW  DATA  TO  'RESTART.DAT'. 

IF  EXCO  IS  UNABLE  70  ACCESS  ANYONE  OF  'INITIAL.DAT' , 
'RESTART.DAT'  OR  'BACKUP.DAT',  OP.  IF  THERE  IS  SOME  ERROR 
IN  READING  THEM  (END-OF-FILE  OR  CONSISTENCY  CHECK  BAD),  IT 
WRITES  AN  ERROR  MESSAGE  ON  'RUNSTAT.DAT'  AND  STOPS. 

##3.I  IF  'RESTART.DAT'  IS  BAD  BUT  'BACKUP.DAT'  IS  COOD,  RENAME 

'BACKUP.DAT'  TO  EE  'RESTART.DAT'.  THIS  RESULTS  IN  THE  LOSS 
OF  ONE  PASS  THROUGH  THE  OUTER  LOOP. 

##3.2  IF  BOTH  'RESTART.DAT'  AND  'BACKUP.DAT'  ARE  BAD,  THE 
LATEST  'RUNSTAT.DAT'  CAN  BE  USED  BY  RENAMING  IT  TO 
BE  'RESTART.DAT'  AND  EDITTIXG  THE  TIME  TAC  (LIME  1) 

OUT.  THIS  RESULTS  IN  LOSS  OF  ALL  DATA  SINCE  THE  LAST 
SUCCESSFUL  RESTART. 

THIS  SHOULD  BE  A VERY  P.ARE  CASE  SINCE  EXCO  DOES  NOT 
HAVE  MORE  THAN  ONE  OF  ANY  OF  ITS  FILES  OPEN  AT  ONCE- 

##4.  DATA  FILE  FORMAT. 

##4.1  RESTART. DAT-THE  MAIN  RECOVERY  DATA  FILE.  IT  IS  ACCESSED 

EACH  TIME  EXCO  IS  STARTED  FOR  THE  RUNNING  VALUES  TO  BE  USED. 

FORMAT:  (NOTE,  THE  ACTUAL  FILE  HAS  COMMA'S  AFTER  SOME  VALUES, 
THESE  ARE  FOR  EASE  IN  EDITING  AND  SHOULD  BE  RETAINED) 
LINE  USE 

1 CURRENT  VALUE  FOR  IS  AMP 

2 CURRENT  VALUE  FOR  HSAMP 

3 CURRENT  VALUE  FOR  SUMP1 

4 CURRENT  VALUE  FOR  SUMP2  • 

5 CURRENT  VALUE  FOR  JCAUSS 

6 CURRENT  VALUE  FOR  DZZZ1 

7 CURRENT  VALUE  FOR  XZZZ(l) 

8 CURRENT  VALUE  FOR  XZZZ(2) 

9 COMMENT  LIKE(NO  DATA  IS  ON  THIS  LINE) 

10  6 INTERNAL  VALUES  FOR  GAUSS  (THE  ARRAY  NST) 

11  7 INTERNAL  VALUES  TOP.  iiANF  (Nl  TO  .N6  AND  ::•*) 

12  3 INTERNAL  VALUES  FOR  BANF  (T!  TO  T3) 

13  3 INTERNAL  VALUES  FOR  BASF  (T4  TO  \‘i) 

14  THE  INTEGER  VALUE  '12345'  IS  REQUIRED.  EXCO 
USES  THIS  AS  A CHECK  Til  MAKE  SURE  THE  FILE  WAS 
CORRECTLY  WRITTEN. 


7'» 


I 


CONTAINING  AND  ERROR  MESSAGE  AMD  STOPS. 

##5.5  CTLXCO.BTN 

PROGRAM  CTLXGO  IS  AN  INDEPENDENT  PROGRAM  THAT  SETS  EVENT 
FLAG  54  SO  THAT  EXCO  WILL  STOP  ON  ITS  NEXT  PASS  THROUGH 
THE  OUTER  LOOP. 

#16.  COMMAND  FILES 


##6.1  TEST.CMD 

CONTAINS  THE  NECESSARY  COMMANDS  TO  THB  EXGO. 

i 


.ENABLE  DATA 
.OPEN  BOX3LD.CMD 

EXGO/FP/CP,EXGO/CR/-WI-BOXBLD/MP 

UNITS-10 

ASG-AP:8,AP1:9,AP2:10 

PRI-10 

// 

.CLOSE 

.OPEN  B0X3LD.0DL 

.ROOT  MAIN-* (XI LL,ERK,CLOB, REST) 

MAIN:  .FCTR  NDRV3D-[1,  1)  FPSLIB/LB: APINIT-l I , I)  FPSLI3/L3- [ I,  1J  SHORT 

ERR:  .FCTR  ERROR 

KILL:  .FCTR  KILLNE 

GLOB:  .FCTR  [340, 340] GLOBAL-! l , 1] FPSLIB/LB 

REST:  .FCTP.  REST1-REST2-REST3-REST4-H,  1JFPSLIB/L3 

RESTI:  .FCTR  LEAF-1340,  340) LC-( I , I) FPSLIB/LB 

REST2:  -FCTR  1 340, 340] M-[ 340, 340] M-[I , I] FPSLI3/LB 
REST3:  .FCTR  [340,340]2SUM-[340,340]  XSUM-] 1,1] FPSLI3/LS 

REST4:  .FCTR  [340,340] TTMOV-fl , I] FPSLIB/L3 
.END 

.CLOSE 

PIP  EXGO.TSK  ;*/DE 

TKB  (fBOXBLD 

PUR  EXCO.*,BOXBLD.* 
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FORTRAN  IV- PLUS  V02-51D 
N0RV3D.FTN  /TR: BLOCKS /WR 


0001 

0002 

0003 

0004 

0005 

0006 
0007 


C**  NDRV3D.FTN 

C NDRV3D:  NEW  3D  DRIVER  LINEAR  LOGGIC 
C VERSION  5/28/78 

C MODIFIED  FOR  AUTO  RESTART  10/4/78  CM. CAMPBELL) 

C 

REAL  JO(1536),JOO(1536),XDAT(130, 10), NORM, MNEW, MOLD 
INTEGER  SN1Z,SINFZ,C0SFZ,DELZ,AZ,S1Z,S2Z,T1Z,T2Z 
INTEGER  H 

INTEGER  COSF , S INF , CEIL , AGOOLD , AMOLD , AGONEW , AMNEW 
INTEGER  AAOLD , AANEW , ASCI , ASC2 , ASC3 , AA2R , AXP 1 , AADLT 
INTEGER  ASS 

INTEGER  AXP2 , AGA , ACLF , AAM1 , AAM2 , AZJ , AX J , ANORM , AS J 


0008 

0009 

0010 


0011 

0012 

0013 

0014 


BYTE  MYDATE(9),MYTIME(8) 

C THIS  COMMON  BLOCK  CONTAINS  PRINT  CONTROL  VARIABLE 
COMMON/ PRINTC/ IPRNT , JPRNT , KPRNT .KOUNT 
COMMON  M,N, KMAX, All, A22 ,Q33C,PIDLT,ALF,DELT, CONST, Rll, 

1 MNEW, MOLD, GONEW.GOOLD, PI, TW0PI,Y1EST,Y2EST,Y3EST, 

2 CHAT, SHAT, XHAT, NORM, JO, Z1,Z2, 

3 C0SY(16) ,SINY(16),AM1 

COMMON  /GN/  DZZZ1,  JGAUSS,  XZZZ(2) 

C THIS  COMMON  CONTAINS  GAUSS  INTERNAL  VARIABLE  FOR  RESTART 
C0MM0N/GSEED/INTRNL(6) 

C THIS  COMMON  CONTAINS  BANF  INTERNAL  VARIABLES  FOR  RESTART 
C0MM0N/BFINT/IBNF(7) ,TBNF(6) 

COMMON  INFLAG .LCHAT ,LSHAT , SN1Z ,COSFZ , SINFZ.DELZ , JNSZ , JZZ , 

1 MEMS, AZ , S1Z.S2Z .INBUFZ ,T1Z ,T2Z , ITOPS , ALDLT.GA ,Q33 ,COSF, 

2 S I NF , KB I AS , CEIL, AGOOLD , AMOLD , AGONEW , AMNEW .AAOLD, AANEW, ASCI, 

3 ASC2 , ASC3 , AA2R , AXP 1 , AADLT , AGA , AXP2 , ACLF , AAM1 , AAM2 , AZJ , AXJ , 

4 ANORM, ASJ, ASS 
C 

C *************************  START  RUN  INITIALIZATION  *************** 


0015 

NORM- 1.0 

C 

MYFLAG  IS  THE  EVENT  FLAC  U: 

0016 

MY FLAG-54 

0017 

CALL  CLREF(MYFLAG) 

0018 

CALL  DATE(MYDATE) 

0019 

C 

CALL  TIME(MYTIME) 

0020 

M-16 

0021 

N-96 

0022 

KMAX- 16 

0023 

IDEV-5 

C 

BOX  MEMORY  ALLOCATIONS 

0024 

INFLAG-17 

0025 

LC HAT-18 

0026 

LSHAT-19 

0027 

SN1Z-20 

0028 

C0SFZ-SN1Z+M 

0029 

SINFZ-COSFZ+M 

0030 

DELZ-SINFZ+M 

0031 

JNSZ-DELZ+N 

0032 

JZZ-JNSZ+N 

0033 

MEMS-JZZ+M*N+M 

0034 

AZ-MEMS+1 1 

0035 

S1Z-AZ+1 1 

78 
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FORTRAN  IV-PLUS  V02-51D 
NDRV3D.FTN  /TR: BLOCKS/WR 


0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 

0060 
0061 
0062 

0063 

0064 

0065 

0066 

0067 

0068 

0069 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

0079 

0080 
0081 
0082 

0083 

0084 

0085 

0086 

0087 

0088 
0089 


S2Z-S1Z+M 

INBUFZ-S2Z+M 

T1Z-INBUFZ+2 

T2Z-T1Z+M 

ITOPS-AZ+21+4*M 

ALF-1 . 

C READ  GENERAL  PARAMETERS  FROM  FILE 

0PEN(UNIT-1 .NAME-' INITIAL.DAT', TYPE-'OLD' .ERR-5000) 

READ(1 ,9999, END-5000) IPRNT.JPRNT.KP RNT.ALP1 10. DELF.Q22C.Q33C, 
X N02 ,N03,ALF 

9999  F0RMAT(3(I5,/),4(E15.8,/),2(I5,/),E15.8) 

CLOSE(UNIT-l) 

IF( IPRNT.NE.O)WRITE( IDEV.651)  Y1EST,Y2EST,ALP110,DELF,Q22C,N02 
651  FORMAT( ' CYCLIC  INPUT'/4X,5F10.5,1I5) 

PI 10-1 0.**(ALP1 10/10.) 

QQ-Q22C**( .25) 

RX-(P110/(SQRT(2.0)*QQ))**(4. 0/3.0) 

FTC-SQRT(2.0)*  RX**(.25)  /QQ 
DELT-DELF*FTC 
Q2  2-Q2  2C*DELT 
Q33-033C*DELT 
R1 I-RX/DELT 

P220-P110*SQRT(Q22C/RX) 

ALDLT-ALF*DELT 
CA-1 .-ALDLT 

A11-10.**((ALP110+1.4)/10.) 

A22-  P220 

P330-.5*Q33C/ALF 
A33-2.0*P330 
PI-3.1415926536 
PI2-2*PI 
TW0PI-2.0*PI 
PIDLT-PI/DELT 

CONST— 2.0*PIDLT*PIDLT/Q22 
DEVI-  SQRT(All) 

DEV2-  SQRT(A22) 

DEV 3-  SQRT(Rll) 

DEV4-SQRT(A33) 

DEVQ2-SQRT(Q22) 

DEVQ3-SQRT(Q33) 

YIEST-O. 

Y2EST-0. 

Y3EST-1. 

IY2-96 . / 2 . /PIDLT*SQRT( 50 . *Q22 )+. 5 

KOUNT-1 

C0SF-20+M 

SINF-COSF+M 

KBIAS-M*(N+1) 

CE I L- ITOPS+KMAX*KBI AS 

ACOOLD-CEIL+1 

AMOLD-AGOOLDfl 

ACONEW-AMOLDfl 

AMNEW-ACONEVH-1 

AAOLD-AMNEW+1 

AANEW-AAOLD+KMAX 

ASCI -AANEW4KMAX 
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0090  ASC2-ASC1+KMAX 

0091  ASC3-ASC2+KMAX 

0092  AA2R-ASC3+KMAX 

0093  AXP1-AA2R+KMAX 

0094  AADLT-AXPl+1 

0095  AGA-AADLT+1 

0096  AXP2-AGA+1 

0097  ACLF-AXP2+1 

0098  AAM1-ACLF+KMAX*KMAX 

0099  AAM2-AAMI+1 

0100  AZJ-AAM2+1 

0101  AXJ-AZJ+KMAX 

0102  ANORM-AXJ+M 

0103  ASJ-AN0RM4-1 

0104  ASS-ASJ+KMAX 

C READ  RESTART  FILE 

C NOTE-FIRST  RUN  IS  CONTROLLED  BY  RESTART  FILE  VAUES  ALSO 
C 

0105  0PEN(UNIT-1 .NAME-' RESTART. DAT' ,TYPE-'OLD' .ERR-5010) 

0106  READ( 1 .9998 .END-501 5) ISAMP .NSAMP .SUMP1 .SUMP2 , JGAUSS , DZZZ  L 
X ,XZZZ .INTRNL, IBNF ,TBNF .MYRSTR 

C THIS  FORMAT  ALSO  USED  BY  RECOVERY  SETUP  CODE  AT  END  OF  OUTER  LOOP 

0107  9998  FORMAT(2(Il5,/),2(El5.8,/),I15,/,3(El5.8,/),/,6IlO,/ 

X ,7I10,/,2(3F15.5,/),I15) 

0108  CLOSE(UNIT-l) 

0109  I F( MYRSTR. NE. 1 2345 )G0  TO  5020 
C RESTART  SUCCESSFULL 

0110  GO  TO  6000 

C UNSUCCESSFUL  RESTART  BRANCHES 
C 

C UNABLE  TO  OPEN  OR  ACCESS  CONSTANT  FILE 


0111 

C 

5000 

CONTINUE 

0112 

CALL  ERROR(l.l) 

C UNABLE  TO  OPEN  PRIMARY  RESTART  FILE 

0113 

5010 

CONTINUE 

0114 

CALL  ERROR( 1,2) 

C END-OF-FILE  ON  PRIMARY  RESTART  FILE 

0115 

5015 

CONTINUE 

0116 

CALL  ERROR( 1,3) 

C CONSISTENCY  VARIABE  -MYRSTR-  DOES  NOT  HAVE  VALUE  OF  '12345' 

0117 

5020 

CONTINUE 

0118 

r 

CALL  ERROR( 1,4) 

C SUCCESSFUL  RESTART 

r 

0119 

6000 

CONTINUE 

0120 

OPEN( UNIT-1 .NAME-' RUNSTAT . DAT' , TYPE-' NEW' ) 

0121 

WRITE( 1 , 999 1 )MYTIME , MYDATE 

0122 

9991 

FORMAT( 1X.8AI .1X.9A1 ,'  RESTART  SUCCESSFUL') 

0123 

WRITE(1 ,9990)ISAMP .NSAMP .SUMP1 .SUMP2 .JGAUSS  .DZZZ1 , 

$ 

X 

XZZZ .INTRNL, IBNF ,TBNF 

0124 

CLOSE(UNIT-l) 

C THIS 

FORMAT  ALSO  USED  BY  RECOVER  SET  UP  CODE  AT  END  OF  OUTER  LOOP 

0125 

9990 

F0RMAT(I15,'  .ISAMP',/ 

X 

115,'  .NSAMP',/ 

80 


11:10:03 


05-APK-79 


PACE  4 


FORTRAN  IV-PLUS  V02-51D 
NDRV3D.FTN  /TR: BLOCKS/WR 


X E15.8,'  .SUMP1',/ 

X E15.8,'  ,SUMP2',/ 

X 115,'  , JGAUSS' ,/ 

X E15.8,'  , DZZZ1' ,/ 

X E15.8,'  ,XZZZ(1)',/ 

X E15.8,'  ,XZZZ(2)',/ 

X ' THE  FOLLOWING  ARE  INTERNAL  TO  GAUSS  AND  BANF',/ 

X ,6110,/, 

X 7110,/ 

X , 3E15.8,/ 

X .3E15.8,/ 

X ' 12345  , FILE  CONSISTENCY  CHECX  VALUE') 

C 

C************************  END  run  CONSTANTS  ****************** 

c 

0126  CALL  GLOBAL 


C 

C *********************  START  PATH  INITIALIZATION  *************** 

C 


0127 

100 

CONTINUE 

0128 

CALL  GAUSS( JSEED.DEV1 ,Y1EST,X1 ) 

0129 

KOUNT-l 

0130 

XDAT(K0UNT,1)-X1 

0131 

CALL  GAUSS( JSEED.DEV2 ,Y2EST,X2) 

0132 

CALL  GAUSS( JSEED.DEV4 ,Y3EST,X3) 

0133 

XDAT(K0UNT,5)-X3 

0134 

AC0S-EXP(X3-1 . )*C0S(X1) 

0135 

ASIN-EXP(X3-1.)*SIN(X1) 

0136 

DO  11  K-l.KMAX 

0137 

YY3- . 5* ( FLOAT( KHAX)+1 . ) 

0138 

C-.5*(FLOAT(K)-YY3) 

0139 

G-G*G*.5 

0140 

AMFAK-O. 

0141 

IF  (C.GT.27.)  GO  TO  12 

0142 

AMFAK-EXP(-G  ) 

0143 

12 

CONTINUE 

0144 

MN-M*N 

0145 

DO  10  I-  1 ,M 

0146 

DO  10  J-l ,N 

0147 

L1-I+M*(J-1) 

0148 

L2-M*(N+1)*(K-1)+IT0PS 

0149 

10 

J00(L1)-J0(L1)*AMFAK 

0150 

L4-776 

0151 

CALL  APPUT( J00,L2 ,MN, 2) 

0152 

CALL  APWD 

0153 

11 

CONTINUE 

0154 

GOOLD- 1 . 0+( - . 5- FLO AT ( KMAX ) 12.) 

0155 

MOLD-SQRT(A33)/2. 

0156 

CONEW-GOOLD 

0157 

MNEW-MOLD 

0158 

CALL  APPUT(GOOLD,AGOOLD,l ,2) 

0159 

CALL  APPUT( MOLD, AMOLD, 1,2) 

0160 

CALL  APPUT(G0NEW,AC0NEW,1 ,2) 

0161 

CALL  APPUT(MNEW,AMNEW,l ,2) 

0162 

CALL  APWD 

0163 

205 

FORMAT( '0' ,8X, 'POSIT. ' , 5X,' POSIT 

.5*SQRT(A33) 


NOD  2 PI',2X, 


EST. 


POSIT. ',9X 
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0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 

0172 

0173 

0174 

0175 

0176 

0177 

0178 


*/'Zl  AND  Z2',19X, 'CYCLIC  LOSS', 5X,'  K-B  EST.  AND  Pll') 


C 

C ********************************  END  path  initialization  ************* 

c 

c **********************  START  POINTS  ********************************* 

c 


450  CONTINUE 

IF  (KOUNT. LE.l)  CO  TO  5 
AC0S-EXP(X3-1.)*C0S(X1) 
ASIN-EXP(X3-1.)*SIN(X1) 

5 CALL  CAUSS(JSEED,DEV3,AC0S,Z1) 
CALL  GAUSS(JSEED,DEV3,ASIN,Z2) 
Xl-Xl  + X2*DELT 
XDAT(K0UNT,1)-X1 
CALL  GAUSS(JSEED,DEVQ2,X2,X2) 
X3-GA*X3+ALDLT 

CALL  GAUSS(JSEED,DEVQ3,X3,X3) 
XDAT(KOUNT,5)-X3 
CALL  LEAF 

XDAT( KOUNT , 2 ) -XHAT 
XDAT(K0UNT,4)-AM1 


0179 


0180 

0181 

0182 


IF(M0D(K0UNT, JPRNT) .EQ.O)WRITE( IDEV, 201 )KOUNT,XDAT( KOUNT,  1)  , 
X XDAT(K0UNT,2),Z1,Z2, 

*(XDAT(KOUNT, 5) ) ,AM1 

201  F0RMAT( '0' ,13 ,IX, 1P2E14.6/4X, 1P2E14.6,4X, 1P2E14.6  /) 
KOUNT-KOUNT  + 1 

IF  ( KOUNT. LE.N02)  GO  TO  450 
C 

q ***********************  end  points  ******************** 

c 

c *********************  START  FINISH  PATH  *************** 

C 


0183 

SUMP-0.0 

0184 

SUMC-0.0 

0185 

DO  1501  I-31.N02 

0186 

XD-ABS(XDAT( I , 1 )-XDAT( 1,2)) 

0187 

1498 

CONTINUE 

0188 

IF(XD.GT.PI)  GO  TO  1499 

0189 

CO  TO  1500 

0190 

1499 

XD-XD-PI2 

0191 

GO  TO  1498 

0192 

1500 

SUMP-(XD)**2+SUMP 

0193 

SUMC-SUMC+( XDAT ( I , 5)-XDAT( I ,4))**2 

0194 

1501 

CONTINUE 

0195 

H-N02-30 

0196 

SUMP-SUMP/H 

0197 

SUMC-SUMC/H 

0198 

XNSAMP-NSAMP 

0199 

XAA-XNSAMP+l .0 

0200 

SUMP 1 - ( S UMP+XNS AMP *S UMP 1 ) / XA A 

0201 

SUMP2-(SUMC+XNSAMP*SUMP2)/XAA 

0202 

DSUMPl-ALOG10(SUMPl)*10. 

0203 

DSUMP2-AL0G10(SUMP2)*10. 

0204 

I F(M0D( NSAMP , KPRNT ) . EQ. 0)WRI TE ( I DEV , 
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1508  FORMAT( 'O', 5X, 'NONLINEAR  CYCLIC  ESTIMATOR') 

IF(MOD(NSAMP,KPRNT) .EQ.O)WRITE(IDEV, 1511 )SUMP1 .DSUMP1 .SUMP2 , 
*DSUMP2 

1511  FORMAT( 2 ('O', 'AVERAGE  STATISTICAL  VARIANCE  -'.1PE13.6,  /IX, 

* 'AVERAGE  COMPUTED  VARIANCE  , 1PE13.6//) ) 

NSAMP-NSAMP+1 

ISAMP-ISAMP+1 


C BUILD  RESTART  FILES 
C 

C FIRST  COPY  THE  CURRENT  PRIMARY  FILE  TO  THE  BACKUP 
C 

0PEN(UNIT-1 ,NAME-'RESTART.DAT' ,TYPE-'OLD' .ERR-7000) 

READ( 1 ,9998 .ERR-7010) II , 12 ,R1 , R2 , 13 , R3 , R4 , R5 , 

X 14,15,16,17,18,19, 

X 110, III, 112, 113, 114, 115, 116, 

X R7,R8,R9,R10,R11,R12, 

X MYRSTR 

CLOSE( UNIT-1) 

I F( MYRSTR. NE. 1234 5)C0  TO  7020 
C WRITE  BACKUP  FILE 

0PEN(UNIT-1 .NAME-' BACKUP. DAT' .TYPE-' UNKNOWN' .ERR-7030) 
WRITE( 1,9990) II, 12, R1.R2 ,I3,R3,R4,R5, 

X 14,15,16,17,18,19, 

X 110, III, 112, 113, 114, 115, 116, 

X R7,R8,R9,R10,R11,R12 
CLOSE(UNIT-l) 

C WRITE  CURRENT  DATA  ON  NEW  PRIMARY  FILE 

0PEN(UNIT-1 .NAME- 'RESTART. DAT' ,TYPE-'UNKNOWN' .ERR-7040) 
WRITE( l , 9990) ISAMP , NSAMP , SUMP1 , SUMP2 , JGAUSS , DZZZl , 

X XZZZ ,1NTRNL,IBNF ,TBNF 
C 

CLOSE(UNIT-l) 

C IF  WE  CET  HERE  WE  SUCCESSFULLY  SET  UP  RESTART-SKIP  AROUND  ERRORS 
CO  TO  7050 
C 

C RESTART  SETUP  ERRORS 
C 

C UNABLE  TO  OPEN  CURRENT  RESTART  FILE  TO  BUILD  BACKUP 


0221 

C 

7000 

CONTINUE 

1 * 

0222 

CALL  ERR0R(2 , 1) 

I 1 

C END 

OF  FILE  ON  RESTART 

FILE 

1 

0223 

7010 

CONTINUE 

0224 

CALL  ERROR(2,2) 

1 

C RESTART  FILE  CONSISTENCY  VALUE 

1 

0225 

7020 

CONTINUE 

1 

0226 

CALL  ERR0R(2 , 3) 

1 

C OPEN 

FAILURE  ON  BACKUP 

FILE 

f 

I 

0227 

7030 

CONTINUE 

1 

0228 

CALL  ERR0R(2 ,4) 

1 

C OPEN 

FAILURE  ON  SECOND 

OPEN  OF 

1 

0229 

7040 

CONTINUE 

1 

0230 

CALL  ERROR(2,5) 

4'  1 

0231 

7050 

CONTINUE 

■ I 

C 
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C SEE  IF  WE  QUIT  DUE  TO  EVENT  FLAG 
C 

0232  CALL  KILLME(HYFLAG) 

0233  IF  (ISAHP.LE.N03)  GO  TO  100 

C 

C *************************  END  FINISH  PATH  ********************** 

C 

c **************************  finish  run  *************************** 

c 

0234  2200  WRITE(IDEV,2201) 

0235  2201  FORMAT  ( 'O', 10X, 'NORMAL  COMPLETION') 

0236  STOP 

0237  END 
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PROGRAM  SECTIONS 


NUMBER 

NAME 

SIZE 

ATTRIBUTES 

1 

$C0DE1 

006546 

1715 

RW.I.CON.LCL 

2 

$PDATA 

0001 14 

38 

RW , D , CON , LCL 

3 

$ I DATA 

001546 

435 

RW,D,CON,LCL 

4 

$VARS 

026530 

5804 

RW,D,CON,LCL 

5 

$TEMPS 

000010 

4 

RW.D.CON.LCL 

6 

PR INTO 

000010 

4 

RW,D,OVR,GBL 

7 

•$$$$• 

014510 

3236 

RW.D.OVR.GBL 

8 

GN 

000016 

7 

RW,D,OVR,GBL 

9 

GSEED 

000014 

6 

RW.D.OVR.GBL 

10 

BFINT 

000046 

19 

RW.D.OVR.GBL 

VARIABLES 

NAME  . TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

AADLT 

1*2 

7-014462 

AAM1 

1*2 

7-014472 

AAM2 

1*2 

7-014474 

AANEW 

1*2 

7-014446 

AAOLD 

1*2 

7-014444 

AA2R 

1*2 

7-014456 

ACLF 

1*2 

7-014470 

ACOS 

R*4 

4-026322 

ACA 

1*2 

7-014464 

AGONEW 

1*2 

7-014440 

AGOOLD 

1*2 

7-014434 

ALDLT 

R*4 

7-014410 

ALF 

R*4 

7-000026 

ALP110 

R*4 

4-026150 

AMFAK 

R*4 

4-026344 

AMNEW 

1*2 

7-014442 

AMOLD 

1*2 

7-014436 

AMI 

R*4 

7-014342 

ANORM 

1*2 

7-014502 

ASCI 

1*2 

7-014450 

ASC2 

1*2 

7-014452 

ASC3 

1*2 

7-014454 

ASIN 

R*4 

4-026326 

ASJ 

1*2 

7-014504 

ASS 

1*2 

7-014506 

AXJ 

1*2 

7-014500 

AXP1 

1*2 

7-014460 

AXP2 

1*2 

7-014466 

AZ 

1*2 

7-014372 

AZJ 

1*2 

7-014476 

All 

R*4 

7-000006 

A22 

R*4 

7-000012 

A33 

R*4 

4-026224 

CEIL 

1*2 

7-014432 

CHAT 

R*4 

7-000112 

CONST 

R*4 

7-000036 

COSF 

1*2 

7-014424 

COSFZ 

1*2 

7-014356 

DELF 

R*4 

4-026154 

DELT 

R*4 

7-000032 

DELZ 

1*2 

7-014362 

DEVQ2 

R*4 

4-026254 

DEVQ3 

R*4 

4-026260 

DEVI 

R*4 

4-026234 

DEV2 

R*4 

4-026240 

DEV  3 

R*4 

4-026244 

DEV  4 

R*4 

4-026250 

DSUMP1 

R*4 

4-026410 

DSUMP2 

R*4 

4-026414 

DZZZ1 

R*4 

8-000000 

FTC 

R*4 

4-026204 

G 

R*4 

4-026340 

CA 

R*4 

7-014414 

GONEW 

R*4 

7-000056 

COOLD 

R*4 

7-000062 

H 

1*2 

4-026120 

I 

1*2 

4-026352 

IDEV 

1*2 

4-026146 

ZNBUFZ 

1*2 

7-014400 

I NR LAG 

1*2 

7-014346 

IPRNT 

1*2 

6-000000 

ISAM? 

1*2 

4-026266 

ITOPS 

1*2 

7-014406 

IY2 

1*2 

4-026264 

II 

1*2 

4-026420 

110 

1*2 

4-026466 

111 

1*2 

4-026470 

112 

1*2 

4-026472 

113 

1*2 

4-026474 

114 

1*2 

4-026476 

115 

1*2 

4-026500 

116 

1*2 

4-026502 

12 

1*2 

4-026422 

13 

1*2 

4-026434 

14 

1*2 

4-026452 

15 

1*2 

4-026454 

16 

1*2 

4-026456 

17 

1*2 

4-026460 

18 

1*2 

4-026462 

19 

1*2 

4-026464 

J 

1*2 

4-026354 

JGAUSS 

1*2 

8-000004 

JNSZ 

1*2 

7-014364 

JPRNT 

1*2 

6-000002 

JSEED 

1*2 

4-026304 

JZZ 

1*2 

7-014366 

K 

1*2 

4-026332 

KBIAS 

1*2 

7-014430 

KMAX 

1*2 

7-000004 

KOUNT 

1*2 

6-000006 

KPRNT 

1*2 

6-000004 

LCHAT 

1*2 

7-014350 

LSHAT 

1*2 

7-014352 

LI 

1*2 

4-026356 

L2 

1*2 

4-026360 

L4 

1*2 

4-026362 

M 

1*2 

7-000000 

MEMS 

1*2 

7-014370 

MN 

1*2 

4-026350 

MNEW 

R*4 

7-000046 

MOLD 

R*4 

7-000052 

MYFLAG 

1*2 

4-026144 

MYRSTR 

1*2 

4-026302 

N 

1*2 

7-000002 

NORM 

R*4 

7-000126 

N02 

1*2 

4-026164 

N03 

1*2 

4-026166 

NSAMP 

1*2 

4-026270 

PACE 
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PI 

R*4 

7-000066 

PIDLT 

R*4 

7-000022 

P12 

R*4 

4-026230 

P110 

R*4 

4-026170 

P220 

R*4 

4-026214 

P330 

R*4 

4-026220 

QQ 

R*4 

4-026174 

Q22 

R*4 

4-026210 

Q22C 

R*4 

4-026160 

Q33 

R*4 

7-014420 

Q33C 

R*4 

7-000016 

RX 

R*4 

4-026200 

Rl 

R*4 

4-026424 

RIO 

R*4 

4-026520 

Rll 

R*4 

7-000042 

R12 

R*4 

4-026524 

R2 

R*4 

4-026430 

R3 

R*4 

4-026436 

R4 

R*4 

4-026442 

R5 

R*4 

4-026446 

R7 

R*4 

4-026504 

R8 

R*4 

4-026510 

R9 

R*4 

4-026514 

SHAT 

R*4 

7-000116 

SINF 

1*2 

7-014426 

SINFZ 

1*2 

7-014360 

SN1Z 

1*2 

7-014354 

SUMC 

R*4 

4-026370 

SUMP 

R*4 

4-026364 

SUMP1 

R*4 

4-026272 

SUMP  2 

R*4 

4-026276 

S1Z 

1*2 

7-014374 

S2Z 

1*2 

7-014376 

TWOPI 

R*4 

7-000072 

T1Z 

1*2 

7-014402 

T2Z 

1*2 

7-014404 

XAA 

R*4 

4-026404 

XD 

R*4 

4-026374 

XHAT 

R*4 

7-000122 

XNSAMP 

R*4 

4-026400 

XI 

R*4 

4-026306 

X2 

R*4 

4-026312 

X3 

R*4 

4-026316 

YY3 

R*4 

4-026334 

Y1EST 

R*4 

7-000076 

Y2EST 

R*4 

7-000102 

Y3EST 

R*4 

7-000106 

Z1 

R*4 

7-014132 

Z2 

R*4 

7-014136 

ARRAYS 

NAME 

TYPE 

ADDRESS 

SIZE 

DIMENSIONS 

COSY 

R*4 

7-014142 

000100 

32 

(16) 

IBNF 

1*2 

10-000000 

000016 

7 

(7) 

1NTRNL 

1*2 

9-000000 

000014 

6 

(6) 

JO 

R*4 

7-000132 

014000 

3072 

(1536) 

JOO 

R*4 

4-000000 

014000 

3072 

(1536) 

MY DATE 

L*1 

4-026122 

000011 

4 

(9) 

MYTIME 

L*1 

4-026133 

000010 

4 

(8) 

SINY 

R*4 

7-014242 

000100 

32 

(16) 

TBNF 

R*4 

10-000016 

000030 

12 

(6) 

XDAT 

R*4 

4-014000 

012120 

2600 

(130,10) 

XZZZ 

R*4 

8-000006 

000010 

4 

(2) 

LABELS 

LABEL 

ADDRESS 

LABEL 

ADDRESS 

LABEL 

ADDRESS 

5 

1-004026 

10 

** 

11 

** 

12 

1-003326 

100 

1-003014 

201' 

3-000542 

205' 

** 

450 

1-003726 

651' 

3-000032 

1498 

1-004476 

1499 

1-004524 

1500 

1-004552 

1501 

** 

1508' 

3-000600 

1511' 

3-000642 

2200 

** 

2201' 

3-000764 

5000 

1-002466 

5010 

1-002504 

5015 

1-002522 

5020 

1-002540 

6000 

1-002556 

7000 

1-006360 

7010 

1-006376 

7020 

1-006414 

7030 

1-006432 

7040 

1-006450 

7050 

1-006466 

9990' 

3-000204 

9991' 

3-000146 

9998' 

3-000066 

9999' 

3-000000 

FUNCTIONS  AND  SUBROUTINES  REFERENCED 
APPUT  APWD  CLOS$  CLREF  DATE  ERROR  GAUSS  GLOBAL  KILLME 


1 


LEAF 


86 


FORTRAN  IV-PLUS  V02-51D 
NDRV3D.FTN  /TR: BLOCKS/WR 


11:10:03  05-APR-79 


PAGE  10 


OPEN$  TIME  $ALG10  $COS  $EXP  $SIN  $SQRT 


TOTAL  SPACE  ALLOCATED  - 054010  11268 
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NDRV3D.FTN  /TR: BLOCKS/WR 


0001 

SUBROUTINE  GAUSS(JS,SD,XM,X) 

0002 

COMMON/GSEED/  NST(6) 

0003 

COMMON  /GN / TWOPI,  J,  XR(2) 

0004 

IF  (J)  10,  10,  20 

0005 

10 

J-2 

0006 

TW0PI-8.*(ATAN(1.)) 

0007 

NST(l)-25 

0008 

NST(2)-8 

0009 

NST<3)-31 

0010 

NST<4)-45 

0011 

NST(5)-20 

0012 

NST(6)-17 

0013 

XR(1)-BANF(NST,1) 

0014 

GO  TO  35 

0015 

20 

GO  TO  (30,40),  J 

0016 

30 

J-2 

0017 

XR( l)-BANF(NST.O) 

0018 

35 

XR(2)-BANF(NST,0) 

0019 

XI- SQRT( ABS ( -2 . *ALOG ( XR( 1 ) ) ) ) 

0020 

XR(2)-TWOPI*XR(2) 

0021 

XR( 1)-X1*SIN(XR(2) ) 

0022 

XR(2)-X1*C0S(XR(2) ) 

0023 

X-XR(1)*SW-XM 

0024 

RETURN 

0025 

40 

J-l 

0026 

X-XR(2)*SI>fXM 

0027 

RETURN 

0028 

END 

88 
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PROGRAM  SECTIONS 


NUMBER 

NAME 

SIZE 

ATTRIBUTES 

1 

$C0DE1 

000434 

150 

RW,I,C0N,LCL 

2 

$PDATA 

000016 

7 

RW ,D,C0N,LCL 

3 

$ I DAT A 

000014 

6 

RW,D,CON',LCL 

4 

$VARS 

000004 

2 

RW , D , CON , LCL 

6 

GSEED 

000014 

6 

RW.D.OVR.GBL 

7 

GN 

000016 

7 

RW.D.OVR.GBL 

ENTRY 

POINTS 

NAME 

TYPE  ADDRESS 

NAME 

TYPE  ADDRESS 

NAM] 

GAUSS  1-000000 

VARIABLES 


NAME 

TYPE 

ADDRESS 

NAME  TYPE 

ADDRESS  NAME 

J 

1*2 

7-000004 

JS  1*2 

F-000002*  SD 

TWOPI 

R*4 

7-000000 

X R*4 

F-000010*  XM 

9 

XI 

R*4 

4-000000 

1 

ARRAYS 

i 

i 

NAME 

TYPE 

ADDRESS 

SIZE 

DIMENSIONS 

A 

NST 

1*2 

6-000000 

000014  6 

(6) 

XR 

R*4 

7-000006 

000010  4 

(2) 

LABELS 

LABEL  ADDRESS 


LABEL  ADDRESS 


LABEL 


10 

** 

20 

1-000152 

30 

35 

1-000234 

40 

1-000414 

FUNCTIONS  AND  SUBROUTINES  REFERENCED 


BANF 

$ALOG  $ATAN  $COS 

$SIN 

$SQRT 

TOTAL 

SPACE  ALLOCATED  - 000544 

178 

TYPE  ADDRESS 


TYPE  ADDRESS 

R*4  F-000004* 

R*4  F-000006* 


ADDRESS 

1-000174 


89 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 
0009 


i 

» 

« 


0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 


i. 

■*c~  i 


FUNCTION  BANF(NS.MODE) 

DIMENSION  NS(6) , NC(6) 

C COMMON  FOR  HOLDING  RESTART  VALUES 
C0MM0N/BFINT/IBNF(7) ,TBNF(6) 

EQUIVALENCE (N1 ,IBNF(1) ) ,(N2,IBNF(2)) , (N3 , IBNF(3) ) 
EQUIVALENCE(N4,IBNF(4)),(N5,IBNF(5)),(N6,IBNF(6)) 
EQUIVALENCE(MP, IBNF( 7 ) ) 

EQUIVALENCE(Tl ,TBNF( 1 ) ) , (T2 ,TBNF(2) ) , (T3  ,TBNF( 3)  ) 
EQUIVALENCE (T4 ,TBNF(4) ) , (T5  ,TBNF(5) ) , (T6 ,TBNF(6)) 
DATA  Ml ,M2 ,M3,M4,M5,M6/59,47 ,62,38,45,23/ 

C MODE-O  TO  CONTINUE,  OTHERWISE  RESTART  WITH 

C INTEGER  NUMBER  NS( 1)*2**18+NS( 2) 

IF  (MODE)  10,  100,  10 
10  Nl-NS(l) 

N2-NS(2) 

N3-NS(3) 

N4-NS(4) 

N5-NS(5) 

N6-NS(6) 

Tl-2.**(-6) 

T2-2.**(-12) 

T3-2.**(-18) 

T4-2.**(-24) 

T5-2.**(-30) 

T6-2.**(-36) 

MP-2**6 

100  DO  200  1-1,6 

GO  TO  (110, 120, 130, 140, 150, 160), I 

110  K-N6*M6 
GO  TO  190 

120  K-N6*M5+N5*M6+KD 
GO  TO  190 

130  K-N6*M4+N5*M5+N4*M6+KD 
GO  TO  190 

140  K-N6*M3+N5*M4+N4*M5+N3*M6-HCD 
GO  TO  190 

1 50  K-N6*M2+N  5*M3+N4*M4+N  3*M5+N2*M6+KD 
GO  TO  190 

160  K-N6  *M 1+N5  *M2+N4  *M3+N3  *M4+N2  *M5+N 1 *M6+KD 

190  KD-K/MP 

200  NC(I)-K-KD*MP 
N1-NC(6) 

N2-NC(5) 

N3-NC(4) 

N4-NC(3) 

N5-NC(2) 

N6-NC(l) 

XN1-N1 

XN2-N2 

XN3-N3 

XN4-N4 

XN5-N5 

XN6-N6 

BANF-XN1*T1+XN2*T2+XN3*T3+XN4*T4+XN5*T5+XN6*T6 

RETURN 
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NDRV3D.FTN  /TR: BLOCKS/WR 

PROGRAM  SECTIONS 

NUMBER  NAME  SIZE  ATTRIBUTES 


1 

$C0DE1 

001344 

370 

RW,I,CON,LCL 

2 

$PDATA 

000016 

7 

RW.D.CON.LCL 

3 

$IDATrt 

000016 

7 

RW,D,CON,LCL 

4 

$VARS 

000066 

27 

RW,D,CON,LCL 

6 

BFINT 

000046 

19 

RW,D,OVR,GBL 

ENTRY 

POINTS 

NAME 

TYPE 

ADDRESS  NAME 

TYPE  ADDRESS 

NAME 

TYPE  ADDRESS 

BANF 

R*4 

1-000000 

VARIABLES 


r 

!? 

NAME 

TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

■ 

I 

1*2 

4-000030 

X 

1*2 

4-000032 

KD 

1*2 

4-000034 

i. 

MODE 

1*2 

F-000004* 

MP 

1*2 

6-000014 

Ml 

1*2 

4-000014 

M2 

1*2 

4-000016 

M3 

1*2 

4-000020 

M4 

1*2 

4-000022 

r 

M3 

1*2 

4-000024 

M6 

1*2 

4-000026 

N1 

1*2 

6-000000 

N2 

1*2 

6-000002 

N3 

1*2 

6-000004 

N4 

1*2 

6-000006 

1 

N5 

1*2 

6-000010 

N6 

1*2 

6-000012 

Tl 

R*4 

6-000016 

T2 

R*4 

6-000022 

T3 

R*4 

6-000026 

T4 

R*4 

6-000032 

T5 

R*4 

6-000036 

T6 

R*4 

6-000042 

XN1 

R*4 

4-000036 

XN2 

R*4 

4-000042 

XN3 

R*4 

4-000046 

XN4 

R*4 

4-000052 

XN5 

R*4 

4-000056 

XN6 

R*4 

4-000062 

NAME 

TYPE 

ADDRESS 

SIZE 

DIMENSIONS 

IBNF 

1*2 

6-000000 

000016 

7 

(7) 

NC 

1*2 

4-000000 

000014 

6 

(6) 

NS 

1*2 

F-000002* 

000014 

6 

(6) 

TBNF 

R*4 

6-000016 

000030 

12 

(6) 

LABELS 


LABEL 

1 

ADDRESS 

LABEL 

ADDRESS 

LABEL 

ADDRESS 

V*'  j 

V-  i 

10 

** 

100 

1-000334 

110 

1-000372 

120 

1-000420 

130 

1-000462 

140 

1-000536 

%*  i 

150 

1-000624 

160 

1-000724 

190 

1-001034 

• 1 

■ t 

200 

** 

■v 

TOTAL 

SPACE  ALLOCATED 

- 001534 

430 
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: 

■ 


I 


0001 

SUBROUTINE  GLOBAL 

C 

VERSION  5/5/1978 

0002 

REAL  A(20),ABOX(20),J0(1536),SIGMA(16), NORM, MOLD, MNEW, 

1 S1(16),S2(16),PSI(96) ,DELJ (96) 

0003 

INTEGER  SN1Z,C0SFZ,SINFZ,DELZ,AZ,S1Z,S2Z,T1Z,T2Z,JNS(96; 

0004 

INTEGER  COSF , S INF , CEI L , AGOOLD , AMOLD , AGONEU , AMNEW 

0005 

INTEGER  AAOLD, AANEW, ASCI , ASC2 ,ASC3 , AA2R, AXP1 ,AADLT 

0006 

INTEGER  ASS 

0007 

INTEGER  AXP2 , AGA , ACLF , AAM1 , AAM2 , AZJ , AXJ , ANORM , ASJ 

0008 

COMMON  M,N,KMAX, All, A22,Q33C,PIDLT,ALF,DELT, CONST, Rll, 

1 MNEW, MOLD, GONEW.GOOLD, PI, TW0PI,Y1EST,Y2EST,Y3EST. 

2 CHAT, SHAT, XHAT, NORM, JO, Z1,Z2, 

3 C0SY(16) ,SINY(16) ,AM1 

0009 

COMMON  INFLAG, LCHAT,LSHAT,SN1Z,C0SFZ,SINFZ,DELZ,JNSZ,JZZ, 

1 MEMS, AZ,S1Z,S2Z .INBUFZ ,TIZ ,T2Z , ITOPS , ALDLT ,GA ,Q33 ,COSF , 

2 SINF.KBIAS, CEIL, AGOOLD, AMOLD, AGONEW.AMNEW, AAOLD, AANEW, ASCI, 

3 ASC2,ASC3,AA2R,AXP1,AADLT, AGA,  AXP2, ACLF,  AAM1.AAM2, AZJ,  AXJ, 

4 ANORM, ASJ, ASS 

C 

GLOBAL  INITIALIZATIONS  FOR  NONLINEAR  FILTER 

0010 

200 

CALL  APINIT(1,1 , III) 

C 

CLEAR  MD(0)-MD(8 191 ) 

0011 

DO  202  1-1,1024 

0012 

202 

J0(I)-0.0 

0013 

I START-0 

0014 

DO  204  1-1,64 

0015 

CALL  APPUT(J0,ISTART,1024,2) 

0016 

ISTART-I START+1 024 

0017 

204 

CONTINUE 

0018 

A5— 1./R11/2. 

0019 

CALL  APPUT(A5, AXPl ,1,2) 

0020 

CALL  APWD 

0021 

X5-DELT*ALF 

0022 

X5--X5 

0023 

CALL  APPUT(X5,AADLT,l ,2) 

0024 

CALL  APWD 

0025 

A5--GA 

0026 

CALL  APPUT(A5,AGA, 1 ,2) 

0027 

CALL  APWD 

0028 

A5— 1./2./Q33C/DELT 

0029 

CALL  APPUT(A5 , AXP2 ,1,2) 

0030 

CALL  APWD 

0031 

A5-1  . 

0032 

CALL  APPUT(A5, ANORM, 1,2) 

0033 

r 

CALL  APWD 

0034 

c 

NORM-1 .0 

t 

c 

PHASE  VARIABLES 

0035 

DO  210  1-1 ,M 

0036 

SIGMA(I)-PI*((2.*I-1.)/FL0AT(M)-1.) 

0037 

COSY( I)-COS(SICMA( I) ) 

0038 

SINY(I)-SIN(SICMA(1)) 

0039 

Sl(I)-COSY(l)/Rll 

0040 

210 

S2(I)-SINY(I)/Rll 

0041 

CALL  APPUT(COSY,COSFZ ,M, 2) 

93 
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0042 

CALL  APPUT(SINY,SINFZ,M,2) 

0043 

CALL  APPUT(S1,S1Z,M,2) 

0044 

CALL  APPUT(S2,S2Z,M,2) 

0045 

CALL  APWD 

c 

C 

PHASE  RATE  VARIABLES 

0046 

DO  220  I-1,N 

0047 

220 

r 

PSI(I)-PIDLT*((2.*I-1.)/FL0AT(N)- 

V* 

C INTERPOLATION  ADDRESS  AND  FACTORS 

0048 

AM-M 

0049 

AN-N 

0050 

DO  230  J-1,N 

0051 

AJ-J 

0052 

PRQ-( AM/AN+AM) /2 .-AM/AN*AJ+AM 

0053 

IRQ-PRQ 

0054 

DELJ(J)-PRQ-IRQ 

0055 

230 

JNS(J)-M0D(IRQ,M)+1 

0056 

CALL  AP  PUT ( DELJ , DELZ , N , 2 ) 

0057 

CALL  APPUT(JNS,JNSZ ,N, 1) 

0058 

c 

CALL  APWD 

t 

c 

EVALUATE  CONVOLUTION  TERMS  A(I) 

0059 

DO  280  I-l.NTERM 

0060 

TEMP-I/FLOAT(N) 

0061 

TEMP-CONST*TEMP*TEMP 

c 

A(I)-0. 

C280 

IF  (TEMP. GT. -20)  A( I)-EXP(TEMP) 

0062 

280 

A(I)-EXP(TEMP) 

0063  • 

DO  282  1-1,5 

0064 

282 

AB0X(I)-A(6-I) 

0065 

AB0X(6)-1 . 

0066 

DO  284  1-1,5 

0067 

284 

AB0X(I+6)-A(I) 

0068 

AB0X( l)-0.0 

0069 

AB0X(ll)-0.0 

0070 

CALL  APPUT( ABOX , AZ , 1 1 , 2 ) 

0071 

CALL  APWD 

C 

DUMPED  ABOX  HERE 

C 

CONSTRUCT  THE  A PRIORI  DENSITY 

C 

CNORM-1 .0/ (TWOPI*SQRT(All*A22) ) 

0072 

CNORM-1 . 

0073 

CL— 0.5/ A2  2 

0074 

SI— 0.5/All 

0075 

DO  290  1-1 ,M 

0076 

CR-SIGMA( I)-Y1EST 

0077 

• 

CR-CR*CR*SI 

0078 

Jl-0 

0079 

DO  290  J-l ,N 

0080 

J2-J1+I 

0081 

TEMP»PSI( J)-Y2EST 

0082 

J0(J2)-0. 

0083 

TEMPl-TEMP*TEMP*CL+CR 

0084 

IF  (TEMPI. LE. -27)  GOTO  290 

0085 

J0( J2)»EXP(TEMP1)*CN0RM 

0086 

290 

Jl-Jl+M 

9*t 
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PROGRAM  SECTIONS 


NUMBER 

NAME 

SIZE 

ATTRIBUTES 

1 

$CODEl 

002120 

552 

RW,I,CON,LCL 

2 

$PDATA 

000020 

8 

RW,D,CON,LCL 

3 

$ I DATA 

000214 

70 

RW,D,CON,LCL 

4 

$VARS 

002540 

688 

RW,D,CON,LCL 

5 

$ TEMPS 

000014 

6 

RW,D,CON,LCL 

6 

.$$$$. 

014510 

3236 

RW,D,OVR,GBL 

ENTRY  POINTS 

NAME  TYPE 

ADDRESS 

NAME 

TYPE  ADDRESS 

NAME 

TYPE  ADDRESS 

GLOBAL 

1-000000 

VARIABLES 

NAME  TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

AADLT 

1*2 

6-014462 

AAMl 

1*2 

6-014472 

AAM2 

1*2 

6-014474 

AANEW 

1*2 

6-014446 

AAOLD 

1*2 

6-014444 

AA2R 

1*2 

6-014456 

ACLF 

1*2 

6-014470 

AGA 

1*2 

6-014464 

AGONEU 

1*2 

6-014440 

AGOOLD 

1*2 

6-014434 

AJ 

R*4 

4-002470 

ALDLT 

R*4 

6-014410 

ALF 

R*4 

6-000026 

AM 

R*4 

4-002456 

AMNEW 

1*2 

6-014442 

AMOLD 

1*2 

6-014436 

AMI 

R*4 

6-014342 

AN 

R*4 

4-002462 

ANORM 

1*2 

6-014502 

ASCI 

1*2 

6-014450 

ASC2 

1*2 

6-014452 

ASC3 

1*2 

6-014454 

ASJ 

1*2 

6-014504 

ASS 

1*2 

6-014506 

AXJ 

1*2 

6-014500 

AXP1 

1*2 

6-014460 

AXP2 

1*2 

6-014466 

AZ 

1*2 

6-014372 

AZJ 

1*2 

6-014476 

All 

R*4 

6-000006 

A22 

R*4 

6-000012 

A5 

R*4 

4-002446 

CEIL 

1*2 

6-014432 

CHAT 

R*4 

6-000112 

CL 

R*4 

4-002514 

CNORM 

R*4 

4-002510 

CONST 

R*4 

6-000036 

COSF 

1*2 

6-014424 

COSFZ 

1*2 

6-014356 

CR 

R*4 

4-002524 

DELT 

R*4 

6-000032 

DELZ 

1*2 

6-014362 

GA 

R*4 

6-014414 

GONEW 

R*4 

6-000056 

GOOLD 

R*4 

6-000062 

I 

1*2 

4-002442 

III 

1*2 

4-002440 

INBUFZ 

1*2 

6-014400 

INFLAG 

1*2 

6-014346 

IRQ 

1*2 

4-002500 

I START 

1*2 

4-002444 

ITOPS 

1*2 

6-014406 

J 

1*2 

4-002466 

JNSZ 

1*2 

6-014364 

JZZ 

1*2 

6-014366 

J1 

1*2 

4-002530 

J2 

1*2 

4-002532 

KBIAS 

1*2 

6-014430 

KMAX 

1*2 

6-000004 

LCHAT 

1*2 

6-014350 

LSHAT 

1*2 

6-014352 

M 

1*2 

6-000000 

MEMS 

1*2 

6-014370 

MNEW 

R*4 

6-000046 

MOLD 

R*4 

6-000052 

N 

1*2 

6-000002 

NORM 

R*4 

6-000126 

NTERM 

1*2 

4-002502 

PI 

R*4 

6-000066 

PIDLT 

R*4 

6-000022 

PRQ 

R*4 

4-002474 

Q33 

R*4 

6-014420 

Q33C 

R*4 

6-000016 

Rll 

R*4 

6-000042 

SHAT 

R*4 

6-000116 

SI 

R*4 

4-002520 

SINF 

1*2 

6-014426 

SINFZ 

1*2 

6-014360 

SN1Z 

1*2 

6-014354 

S1Z 

1*2 

6-014374 

S2Z 

1*2 

6-014376 

TEMP 

R*4 

4-002504 

TEMPI 

R*4 

4-002534 

TWOPI 

R*4 

6-000072 

T1Z 

1*2 

6-014402 

T2Z 

1*2 

6-014404 

XHAT 

R*4 

6-000122 

X5 

R*4 

4-002452 

Y1EST 

R*4 

6-000076 

Y2EST 

R*4 

6-000102 

Y3EST 

R*4 

6-000106 

Z1 

R*4 

6-014132 

Z2 

R*4 

6-014136 

96 
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NAME 

TYPE 

ADDRESS 

SIZE 

DIMENSIONS 

A 

R*4 

4-000000 

000120 

40 

(20) 

ABOX 

R*4 

4-000120 

000120 

40 

(20) 

COSY 

R*4 

6-014142 

000100 

32 

(16) 

DELJ 

R*4 

4-001340 

000600 

192 

(96) 

JNS 

1*2 

4-002140 

000300 

96 

(96) 

JO 

R*4 

6-000132 

014000 

3072 

(1536) 

PSI 

R*4 

4-000540 

000600 

192 

(96) 

SIGMA 

R*4 

4-000240 

000100 

32 

(16) 

SINT 

R*4 

6-014242 

000100 

32 

(16) 

SI 

R*4 

4-000340 

000100 

32 

(16) 

S2 

R*4 

4-000440 

000100 

32 

(16) 

LABELS 


LABEL 

ADDRESS 

LABEL 

ADDRESS 

LABEL 

ADDRESS 

200 

** 

202 

** 

204 

** 

210 

** 

220 

** 

230 

** 

280 

290 

** 

1-002052 

282 

** 

284 

** 

FUNCTIONS  AND  SUBROUTINES  REFERENCED 


API NIT  APPUT  APWD 


$COS 


$EXP  $SIN 


TOTAL  SPACE  ALLOCATED  - 021640  4560 

,GLOBAL-GLOBAL 

> 
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PACE  1 


SUBROUTINE  LEAF 

REAL  MNEW, MOLD, NORM, A0LD(16), AKRNL(16, 16), B(2),XJ(16),ZJ(16). 

1  JNEWK( 16) , J0(1536) ,ANEW( 16) , AJOLDK( 16) ,AKRN(256) 

INTEGER  SN1Z,SINFZ,C0SFZ,DELZ,AZ,S1Z,S2Z,T1Z,T2Z 
INTEGER  MEM(6) ,KADR( 16) 

INTEGER  COSF.S INF, CEIL, AGOOLD , AMOLD , AGON EW , AMNEW 
INTEGER  AAOLD, AANEW , ASC 1 , ASC2 , ASC3 , AA2R , AXP 1 , AADLT 
INTEGER  ASS 

INTEGE  R AXP2 , AGA , ACLF , AAM1 , AAM2 , AZ J , AX J , ANORM , AS J 
REAL  A(2) ,FMEM(6) 

C THIS  COMMON  CONTAINS  THE  PRINT  FLAGS-SPECIFICALLY  JPRNT  AND  KOUNT 
C DATA  'TYPE'D  AT  BOTTOM  OF  THIS  ROUTINE  IF  MOD(KOUNT, JPRNT)  IS  ZERO 
COMMON/PR INTC/ IPRNT , J PRNT , KPRNT , KOUNT 
COMMON  M.N.KMAX, All, A22,Q33C,PIDLT,ALF,DELT, CONST, Rll, 

1 MNEW,MOLD,GONEW,GOOLD,PI,TWOPI, YIEST, Y2EST, Y3EST, 

2 CHAT, SHAT, XHAT, NORM, JO, Zl,Z2, 

3 C0SY(16) ,SINY(16) ,AMl 

COMMON  INFLAG, LCHAT,LSHAT,SNlZ,COSFZ,SINFZ,DELZ,JNSZ,JZZ, 

1 MEMS , AZ , S1Z , S2Z , IN  BUFZ , T1Z , T2Z , ITOPS , ALDLT, GA , Q33 , COSF , 

2 SINF.KBIAS, CEIL, AGOOLD, AMOLD, AGONEW, AMNEW, AAOLD, AANEW, ASCI, 

3 ASC2 ,ASC3,AA2R, AXP 1 , AADLT, AGA, AXP2 , ACLF,  AAM1 , AAM2 , AZ J , AXJ , 

4 ANORM, AS J, ASS 

C ******************  START  LEAF  MODULE  ****************************** 


0013 

Xl-SECNDS(O.O) 

0014 

IDRV-5 

0015 

Tl-SECNDS(Xl) 

0016 

CALL  VRAMP(AGOOLD, AMOLD, ASCI, 1 

, KMAX) 

0017 

CALL  APWR 

0018 

CALL  VSADD(ASCl,l, AMOLD, AAOLD, 

l.KMAX) 

0019 

CALL  APWR 

0020 

CALL  VRAMP (AGONEW, AMNEW, ASC2.1 

,KMAX) 

0021 

CALL  APWR 

0022 

CALL  VS ADD (ASC2.1, AMNEW, AANEW, 

1.16) 

0023 

CALL  APWR 

0024 

IIIl-ASS+2*M 

0025 

IV-IIII+1 

0026 

XXI— 1. 

0027 

CALL  APPUT(XXl ,1111,1,2) 

0028 

CALL  APWD 

0029 

CALL  VSADD(AA0LD,1 ,IIII,ASC2,1 

.16) 

0030 

CALL  APWR 

0031 

CALL  VEXP(ASC2,l,IV,l,16) 

0032 

CALL  APWR 

0033 

CALL  VSQ(IV, 1 , ASCI ,1 , KMAX) 

0034 

CALL  APWR 

0035 

CALL  VSMUL(ASC1 ,1 , AXP1 , ASC2 , 1 , 

KMAX) 

0036 

CALL  APWR 

0037 

CALL  VEXP(ASC2 , 1 , AA2R , 1 ,KMAX) 

0038 

CALL  APWR 

0039 

T2-SECNDS(X1) 

0040 

JZ-ITOPS 

0041 

MEM(1)-JZ+M*N-1 

0042 

MEM(2)-MEM(1) 

0043 

MEM(3)-JZ+M*N 

0044 

MEM(4)-JZ 

98 
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LEAF. 

FTN 

/TR: BLOCKS/WR 

0045 

MEM( 5 ) -JZ+M*N-4*M- 1 

0046 

MEH(6)-JZ-1 

0047 

B(1)-Z1 

0048 

B(2)-Z2 

0049 

CALL  APPUT(B,18,2,2) 

0050 

AAA-FLOAT(KBIAS) 

0051 

II-ASS+3 

0052 

CALL  APPUT(AAA,II,1,2) 

0053 

FMEM( 1 )-FLOAT(NEM( 1 ) ) 

0054 

FMEM(2)“FLOAT(HEM(2) ) 

0055 

FMEM( 3 )-FLOAT( MEM( 3 ) ) 

0056 

FMEM(4)-FLOAT(MEM(4) ) 

0057 

FMEM( 5)-FL0AT(MEM( 5 ) ) 

0058 

FMEM(6)-FL0AT(MEM(6)) 

0059 

III-ASS+4 

0060 

CALL  APPUT(FMEM,III,6,2) 

0061 

CALL  APWD 

0062 

CALL  LC( I II, II, KBIAS , IV , 1NBUFZ , AA2R.ASC1 ) 

0063 

CALL  APUR 

0064 

T3-SECNDS(X1) 

0065 

AB-NORM 

0066 

TNORM-l./AB 

0067 

CALL  APPUT( TNORM , ANORM ,1,2) 

0068 

CALL  APWD 

0069 

CALL  ME( AANEW , AAOLD , ASCI , AADLT , ASC2 , ASC3 , AGA , AXP2 , ACLF , ANORM) 

0070 

CALL  APWR 

0071 

T4-SECNDS(Xl) 

0072 

CALL  TTMOV(ACLF, 4608, 256) 

0073 

CALL  APWR 

0074 

T5-SECNDS(X1) 

c **** 

0075 

DO  600  K-l,l6 

0076 

600 

XJ(K)-0.0 

0077 

DO  609  K-1,16 

0078 

609 

CALL  APPUT(XJ,IT0PS+M*N+,(X-1  )*M*(NH)  ,16 ,2) 

0079 

CALL  APWD 

c **** 

C 

DOES  AMPLITUDE  CONVOLUTION  FOR  EACH  I,J 

0080 

T6-SECNDS(X1) 

0081 

CALL  W 

0082 

CALL  APWR 

0083 

T7-SECNDS(X1) 

0084 

CALL  XSUM( ITOPS ,M, AXJ ,KBIAS) 

0085 

CALL  APWR 

0086 

CALL  ZSUM( ITOPS ,M ,AZJ , KB IAS) 

0087 

CALL  APWR 

0088 

T8-SECNDS(X1) 

0089 

CALL  DOTPR(AXJ,1,COSFZ,1,ASS,M) 

0090 

CALL  DOTPR(AXJ, 1 , SINFZ, 1 , ASS+1 ,M) 

0091 

CALL  DOTPR(AZJ,l, AANEW, 1,AAM1,KMAX) 

0092 

CALL  VSQ(AANEW , 1 , ASCI , 1 ,KMAX) 

0093 

CALL  DOTPR( ASCI , 1 , AZJ , 1 , AAM2 , KMAX) 

0094 

CALL  SVE(AZJ,l, ANORM, KMAX) 

0095 

CALL  APWR 

0096 

CALL  APCET(A,ASS,2,2) 

0097 

CALL  APCET(Y,AAMl ,1,2) 

99 
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0098 

0099 

0100 
0101 
0102 

0103 

0104 

0105 

0106 

0107 

0108 

0109 

0110 
0111 
0112 

0113 

0114 

0115 

0116 

0117 

0118 
0119 


CALL  APGET(YY,AAM2,1,2) 

CALL  APCET(ABL,AN0RM,1,2) 

CALL  APWD 
T0-SECNDS(X1 )-T8 
XHAT-ATAN2(A( 2) ,A( 1) ) 

NORH-ABL 

AMl-Y/ABL 

AM2-YY/ABL 

CALL  VMOV ( ACONEW , 1 , ACOOLD ,1,2) 

CALL  APWR 

S1-AMAX1 ( AM2-AM1**2 , 1 . E-18 ) 

Sl-SQRT(Sl) 

G0NEW-(-.5-FL0AT(KMAX)/2.)*(l./2.)*Sl+AMl 

MNEW-.5*S1 

CALL  APPUT(CONEW, ACONEW, 1,2) 

CALL  APPUT(MNEW,AMNEW,l,2) 

CALL  APWD 

C ******************  END  ACON  MODULE  ******************************* 
T9-SECNDS(X1) 

IF(MOD(KOUNT, JPRNT) .EQ.O)TYPE  * ,T1 ,T2-T1 ,T3-T2 .T4-T3.T5-T4 ,T6-T5 
X ,T7-T6,T8-T7,T9-T8,T9 

IF(MOD(XOUNT, JPRNT). EQ.O)TYPE  *,T0 
RETURN 
END 


100 
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LEAF . FTN  /TR : BLOCKS/WR 

PROGRAM  SECTIONS 


NUMBER 

NAME 

SIZE 

ATTRIBUTES 

1 

$C0DE1 

002462 

665 

RW,I,CON,LCL 

2 

$PDATA 

000044 

18 

RW,D,CON,LCL 

3 

$IDATA 

000636 

207 

RW,D,CON,LCL 

4 

$VARS 

005062 

1305 

RW , D , CON , LCL 

6 

PRINTC 

000010 

4 

RW,D,OVR,CBL 

7 

•$$$$. 

014510 

3236 

RW,D,OVR,GBL 

ENTRY 

POINTS 

NAME 

TYPE 

ADDRESS 

NAME 

TYPE  ADDRESS 

NAME 

TYPE  ADDRESS 

LEAF 

1-000000 

VARIABLES 

NAME  TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

NAME 

TYPE 

ADDRESS 

AAA 

R*4 

4-004754 

AADLT 

1*2 

7-014462 

AAM1 

1*2 

7-014472 

AAM2 

1*2 

7-014474 

AANEW 

1*2 

7-014446 

AAOLD 

1*2 

7-014444 

AA2R 

1*2 

7-014456 

AB 

R*4 

4-004770 

ABL 

R*4 

4-005036 

ACLF 

1*2 

7-014470 

AGA 

1*2 

7-014464 

ACONEW 

1*2 

7-014440 

ACOOLD 

1*2 

7-014434 

ALDLT 

R*4 

7-014410 

ALF 

R*4 

7-000026 

AMNEW 

1*2 

7-014442 

AMOLD 

1*2 

7-014436 

AMI 

R*4 

7-014342 

AM2 

R*4 

4-005046 

ANORM 

1*2 

7-014502 

ASCI 

1*2 

7-014450 

ASC2 

1*2 

7-014452 

ASC3 

1*2 

7-014454 

ASJ 

1*2 

7-014504 

ASS 

1*2 

7-014506 

AXJ 

1*2 

7-014500 

AXP1 

1*2 

7-014«*60 

AXP2 

1*2 

7-014466 

AZ 

1*2 

7-014372 

AZJ 

1*2 

7-014476 

All 

R*4 

7-000006 

A22 

R*4 

7-000012 

CEIL 

1*2 

7-014432 

CHAT 

R*4 

7-000112 

CONST 

R*4 

7-000036 

COSF 

1*2 

7-014424 

COSFZ 

1*2 

7-014356 

DELT 

R*4 

7-000032 

DELZ 

1*2 

7-014362 

GA 

R*4 

7-014414 

CONEW 

R*4 

7-000056 

GOOLD 

R*4 

7-0C0062 

IDEV 

1*2 

4-004730 

II 

1*2 

4-004760 

III 

1*2 

4-004762 

IIII 

1*2 

4-004736 

INBUFZ 

1*2 

7-014400 

INFLAG 

1*2 

7-014346 

IPRNT 

1*2 

6-000000 

ITOPS 

1*2 

7-014406 

IV 

1*2 

4-004740 

JNSZ 

1*2 

7-014364 

JPRNT 

1*2 

6-000002 

JZ 

1*2 

4-004752 

JZZ 

1*2 

7-014366 

K 

1*2 

4-005010 

KBIAS 

1*2 

7-014430 

KM  AX 

1*2 

7-000004 

KOUNT 

1*2 

6-000006 

KPRNT 

1*2 

6-000004 

LCHAT 

1*2 

7-014350 

LSHAT 

1*2 

7-014352 

M 

1*2 

7-000000 

MEMS 

1*2 

7-014370 

MNEW 

R*4 

7-000046 

MOLD 

R*4 

7-000052 

N 

1*2 

7-000002 

NORM 

R*4 

7-000126 

PI 

R*4 

7-000066 

PIDLT 

R*4 

7-000022 

Q33 

R*4 

7-014420 

Q33C 

R*4 

7-000016 

RU 

R*4 

7-000042 

SHAT 

R*4 

7-000116 

S1NF 

1*2 

7-014426 

SINFZ 

1*2 

7-014360 

SNIZ 

1*2 

7 -014354 

SI 

R*4 

4-005052 

SIZ 

1*2 

7-014374 

S2Z 

1*2 

7-014376 

TNORM 

R*4 

4-004774 

TWO  PI 

R*4 

7-000072 

TO 

R*4 

4-005042 

Tl 

R*4 

4-004732 

TIZ 

1*2 

7-014402 

T2 

R*4 

4-004746 

T2Z 

1*2 

7-014404 

T3 

R*4 

4-004764 

T4 

R*4 

4-005000 

T5 

R*4 

4-005004 

T6 

R*4 

4-005012 

T7 

R*4 

4-005016 

T8 

R*4 

4-005022 

T9 

R*4 

4-005056 

XHAT 

R*4 

7-000122 

XXI 

R*4 

4-004742 

XI 

R*4 

4-004724 

Y 

R*4 

4-005026 

YY 

R*4 

4-005032 
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YlEST  R*4  7-000076 
Zl  R*4  7-014132 


Y2EST  R*4  7-000102  Y3EST  R*4  7-000106 

Z2  R*4  7-014136 


ARRAYS 


NAME 

TYPE 

ADDRESS 

SIZE 

DIMENSIONS 

A 

R*4 

4-004664 

000010 

4 

(2) 

AJOLDK  R*4 

4-002510 

000100 

32 

(16) 

AKRN 

R*4 

4-002610 

002000 

512 

(256) 

AKRNL 

R*4 

4-000100 

002000 

512 

(16,16) 

ANEW 

R*4 

4-002410 

000100 

32 

(16) 

AOLD 

R*4 

4-000000 

000100 

32 

(16) 

B 

R*4 

4-002100 

000010 

4 

(2) 

COSY 

R*4 

7-014142 

000100 

32 

(16) 

FMEM 

R*4 

4-004674 

000030 

12 

(6) 

JNEUK 

R*4 

4-002310 

000100 

32 

(16) 

JO 

R*4 

7-000132 

014000 

3072 

(1536) 

KADR 

1*2 

4-004624 

000040 

16 

(16) 

MEM 

1*2 

4-004610 

000014 

6 

(6) 

SI  NY 

R*4 

7-014242 

000100 

32 

(16) 

XJ 

R*4 

4-002110 

000100 

32 

(16) 

ZJ 

R*4 

4-002210 

000 100 

32 

(16) 

LABELS 

LABEL  ADDRESS  LABEL  ADDRESS  LABEL  ADDRESS 

600  **  609  ** 


FUNCTIONS  AND  SUBROUTINES  REFERENCED 


APCET 

APPUT 

APWD 

APWR 

DOTPR 

LC 

ME 

SECNDS 

SVE 

TTMOV 

VEXP 

$ATAN2 

VMOV 

$SQRT 

VRAM? 

VSADD 

VSMUL 

VSQ 

W 

XSUM 

ZSUM 

$AMAX1 

TOTAL  SPACE  ALLOCATED  - 025166  5435 


,LEAF-LEAF 


> 
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DEFINE  LC(III,II,KBIAS,AANEW,INBUFZ,AA2R,ASCl) 

LOCAL  K,A,B 

K-0 

CALL  VFIX(III.l,l,l,6) 

LOOPrA-AANEW-FK 

B-AA2R+K 

CALL  VSMUL(18, 1 ,A,IN8UFZ , 1 , 2) 

CALL  VMOV (B, 1,7, 1,1) 

CALL  VSADD(IIIt 1, II, ASCI , 1,6) 

CALL  VMOV(ASCl, 1,111,1,6) 

CALL  RLNLF(O) 

CALL  VFIX(ASCl,l,l,l,5) 

K=K+1 

IF  K<16  COTO  LOOP 
END 


"RLNLFE. FSO 

"DIC.FSO  FAST  2-LOOP  BOX 
"DOES  FILTER (FRANK),  THEN 
"CONVOLVE (JACK) . 

"INITSW-0  FIRST  CALL-ONLY  DOES  CONVOLVE. 
"INITSW-0  FIRST  FILTER  CALL 

"-1  REST  OF  FILTER  CALLS 
"-2  CONVOLVE  CALL 
"INITSW-1  FOR  EACH  ESTIMATE. 

"REMOVE  HALT  BETWEEN  FILTER, CONVOLVE 
"VERSION 

"3-8-78  HALT  IM  MIDDLE 
"RLNLEH l 6 TO  RLNLFE3D 
"3-8-78 
"CALLS  EXPDO 

"NEXTMD  -ADDRESSING  ENTRY  FOR  EXPDO 
"LD  NORM  FROM  MD  IN  FRANK 
"HALT  AFTER  FRANK 


$TITLE  RLNLF 
$ENTRY  RLNLF, 1 
$ENTRY  NEXTMD 
$EXT  EXPDO 


"CAI.L  NLF(INITSW-CHECK) 
"SP(0):-NEXT  FREE  MD  ADDR. 
"DO  EXP  IN  BOX 


"SIZINC 

MV  $E()U  16. 

NV  $EQU  96. 

MNV  $EQU  MV*NV 
SNIZV  $EQU  20. 

COSFZ  $EQU  SMIZV+MV 
SINFZ  $EQU  COSFZ-tMV 
DELZ  $EQU  SINFZ+MV 
JNSZZ  $EQU  DELZ+NV 
JZZ  $EQU  JNSZZ+NV 
MEMS  $EQU  JZZ-HMNV+MV 
AZ  $EQU  MEMS+I 1 . 

NXPREE  $EQU  AZ+11. 
"TABLE  MEMORY  ADDRESES 
JTMA  $EQU  10000 
NORLV  $EQU  JTMA+NV+11. 
"MN1V  $EQU  MNV+JZ-1 
"MN2V  $EQU  HNV+JZ 
XINCV  $EQU  1 
Ml V $EQU  MV-1 
TWV  $EQU  2 
MMV  $EQU  TWV*MV 
"MNNV  $EQU  MNV+JZ-1 
CHATV  $EQU  18. 

SHATV  $EQU  19. 

CHF.CKV  $EQU  0 
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"S  PAD  ADDRESSES 

"GLOBAL  CONSTANTS 
M $EQU  1 
N $EQU  2 
MN  $EQU  3 


"FOR  FILTER 

ICNT  $EQU  3 

MNN  $EQU  4 

JCNT  $EQU  4 "CH 

MN1  $EQU  5 

JFI  $EQU  5 

M2  $EQU  6 

XINC  $EQU  7 

JRA  $EQU  7 

JNSRA  $EQU  8. 

JWA  $EQO  8. 

Ml  $F.QU  9. 

MM  $EQU  10. 

MN2  $EQU  11. 

TW  $EQU  12. 

JBI  $EQIJ  12. 

JNSZ  $EQU  13. 

COSFA  $EQU  13. 

NORL  $EQU  14. 

CHAT  $EQU  14. 

SIMFA  $EQU  14. 
INITSW  $EQU  0 " 

SNIZ  $EQU  0 
RLNLF:NOP 

JSR  F.XPDO 
JMP  ENTER 1 

NEXTMD:  LDSPI  0;DB-NXFREE 
RETURN 
NOP 
NOP 

ENTER1 :LDMA; 

DB-2 


"RETURN  SP (0) : -NEXT  FREE  MD  ADDR. 


"MAIN  ENTRY  FROM  HOST 


LDMA; 

DB-3 

LDSPI  MNN; 
DB-MD 

LDSPI  MM 1 ; 
DB-MD 

LDSPI  MN2 ; 
DB-MD 


NOP 


LDSPI  M; 
DB-MV 

LDDA ; 

DB-5 

LUSPI  N; 
D3-NV 

LDSPI  MM; 
DB-MNV 

LDSPI  JMSKA; 
DB-JZZ 

LDSPI  XINC; 
DB-XINCV 

LDSPI  Ml; 
DB-M1V 

LDSPI  MM; 
DB-MMV 


LDSPI  TV; 
DB-TWV 

LDSPI  JNSZ; 
DB-JNSZZ 

LDSPI  NOKL; 
DB-NORLV 


MOV  INITSW, INIT5W 
BEQ  FIRST 


LDSPI  15;DB-2 
SUB  15, INITSW 
BNE  NXLABEL 
JMP  CON VOL 
NXI.ABEL:  JMP  SECOND 

FIRST :LDDPA; 

DB-10. 

LDTMA;DB-!ONE 

NOP 

DPX<TU 

MOV  KORL.NOKL; 
SETTMA; 

OUT; 

D3-DPX 

LUTMA; 

DB-JTMA+10. 


"IF  INITSW-2  COTO  CONVOL 


"ELSE  GOTO  NON-FIRST  FILTER 


"TM(SP (NOKL) ) : ■ 1.0 
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LDMA; 

DB-DELZ 

"STO  N DELJ  IN  TM 
MOV  M.JCNT 

LP1 : INCMA 

INCTMA; 

OUT; 

DB-MD 

DEC  JCNT 

BGT  LPl 

LDSPI  SN1Z ;DB»SN1ZV 

JMP  ST1  "DO  ONLY  CONVOLVE  FIRST  TIME 

"DO  FRANK 

SECO ND:LDDPA;  "BECIN  FILTER 

DB-10. 

LDSPI  0;DB-CHATV-1  "AD DR  OF  NORM 

MOV  0,0;SETMA 

NOP 

NOP 

MOV  NORL.NORL; 

SETTMA; 

OUT; 

DB-MD  "NORM 


[ : 

STltLDMA; 

i DD-7 


LDDPA ; 
DB-0 


"NORM*EXP(-A**2/2*R)~>  NORM 


LDTMA; 

DB-JONE 

"MOV  NORL.NORL; 
"SET1WA 

LDMA;DB-2 

DPX<MD 

NOP 

FMUL  TM.DPX 
LDSPI  MNN; DB-MD 
FMUL 
FMUL 
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DPX<FM 

MOV  NOHL.NORL; 

SETIMA ; 

OUT; 

DB-DPX 

I 

"STO  M SN  IN  DPX  & DPY 

LPCYC: LDSPI  SM1Z; 

OB-SN1ZV 

LP2:MOV  SNIZ.SNIZ; 

SETMA 

MOV  NOHL.NORL; 

SETTMA 

INC  SN1Z 

1 

FMUL  TM.MD 

I | 

FMUL 

FMUL; 

DEC  M 

I J 

DPX(0)<FM.DPY(0)<FM 

INCDPA 

BGT  LP2 

LDSPI  It; 

DB-MV 

DEC  TW 

BGT  LPCYC 

LDSPI  TW; 

DB-TWV 

LDTMA; 

DB-JTMA+NV+1 1. 

LDSPI  M; 

DB-MV 

- I ] 

LOOP:DEC  JNSRA 

MOV  JNSRA, JNSKA; 

SETMA 

NOP 

NOP 

LDSPI  JHSZ; 

DB-MD 
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DECTMA 


AUDI  XINC.JNSZ 
BEQ  BIELP 
JMP  BIOLP 

BIELP: ADD#  XINC.JNSZ; 
SETDPA 

SUB  1.5 

SUB  1.11. 

ADD#  HNl.JNSZ; 


SETMA 

"GET  J1 

INC  JNSZ 

MOVR  1.6 

"M2-16. 

AND  Ml, JNSZ; 

FMUL  OPX(-2),MD 

"J1*SN1 >J1 

ADD#  HNl.JNSZ; 

SETMA; 

FMUL 

"CET  J2 

FMUL 

ADD#  MN2.JNSZ; 

SETMA; 

DPY (-2 ) <FM 

"CET  J3 

"STO  J1  IN  DPY 

ADD  TW. JNSZ; 

FMUL  DPY(-l).MI) 

"J2*SN2 >J2 

FMUL; 

INCDPA 

FMUL  DPX(-1),MD 

"J3*SN3— >J3 

FMUL; 

DPX(-2)<FM; 

INCDPA 

"STO  J2  IN  DPX 

AND  111, JNSZ; 

FMUL 

ADO#  HNl.JNSZ; 

SETMA : 

DPY (-2 ) <FM 

"CET  J4 

"STO  J3  IN  DPY 

NOP 

ADD#  NN2.JNSZ; 

SETMA 

"CET  J5 

ADI)  TW.JNSZ; 

FMUL  DPY (-1 ) ,MD 

"J4*SMA >J4 

FMUL 
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FMUL  DPX(O) ,MD 
FSUB  DPX(-3),DPY(-A) 

FMUL; 

DPX(-1 )<FM; 

FADD 

IXLP: AND  Ml, JNSZ; 

FMUL  TM.FA; 

FSUB  DPY(-2),DPX(-3) 

ADD#  MN1, JNSZ; 

SETMA; 

DPY(0)<FM; 

FMUL; 

FADD 

FMUL  TM.FA 

ADD#  MN2.JNSZ; 

SETMA; 

FADD  FM.DPY(-A); 

FMUL 

ADD  TW.JNSZ; 

FMUL  DPY(1),MD;  "J6*SN6 >J6 

FADD 

FMUL; 

FADD  FM,DPX(-3) ; "DELJ*(J3-J2)+J2 

INCDPA; 

INC  MMM; 

SETMA; 

MI<FA 

FMUL  DPX(1),MD 

FSUB  PPX(-2),DPY(-3);  "JA-J3 

DEC  M2 

FMUL; 

DPX(0)<FM;  "STO  J6  IN  DPX  5 

INCDPA; 

FADD; 

INC  MNN; 

SETMA; 

HKFA; 

BGT  IF.LP 

SUB  10.. A 

JMP  STEP 

BIOLP: ADD#  XINC, JNSZ; 

SETDPA 


"J5*SN5 > J5 

"J2-J1 

"STO  J4  IN  DPX  3 

"CHECK  IF  JHSZ  IS  32 
"DELJ*(J2-J1) 

"J3-J2 

"GET  J6 

"STO  J5  IN  DPY  A 

"DELJ*(J3-J2) 

"GET  J7 

"DELJ*(J2-J1)+J1 
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SUB  1,5 


SUB  1,11. 

ADD#  MNl.JNSZ; 
SETMA 

INC  JNSZ 

MOVR  1,6 

ADD#  MN1,JNSZ; 
SETMA; 

FMUL  OPY(-2),MD 


AND  Ml, JNSZ 

ADD#  till 2, JNSZ ; 

SETMA; 

FMUL 

ADD  TW, JNSZ; 

FMUL  DPX(-l),MD 

FMUL; 

UPX(-2)<FM; 

INCDPA 

FMUL  DPY(-1),MD 
FMUL; 

DPY(-2 )<FM; 

INCDPA 

FMUL 

DPX(-2)<FM; 

ADD#  MNl.JNSZ; 

SETMA 

AND  Ml, JNSZ 

ADD#  MN2, JNSZ; 

SETMA 

ADD  TW, JNSZ ; 

FMUL  DPX(-l),r.J 

FMUL; 

FSUB  DPY(-3),DP>:(-4) 
FMUL  DPY (0) ,MD 
FMUL; 

DPY (-1 )<FM; 

FADD 


IOLPsFMUL  TM, FA; 

FSUB  DPX(-2),DPY(-3) 
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> w 


ADD#  MNl.JNSZ; 

SETMA; 

DPX(0)<FM; 

FADD; 

FHUL 

AND  M1.JIISZ; 

FMUL  TM.FA 

ADD#  MN2.JNSZ; 

SETMA; 

FADD  FM,DPX(-4); 

FMUL 

ADD  TW.JNSZ; 

FMUL  DPX(1),MD; 

FADD 

FMUL; 

FADD  FM,DPY(-3); 
INCDPA ; 

INC  MNN; 

SETMA; 

MKFA 

FMUL  DPY ( 1 ) • MO 

FSUB  DPY (-2 ) ,DPX(-3) ; 
DEC  M2 

FMUL; 

DPY(0)<FM; 

INCDPA; 

FADD; 

INC  MNN ; 

SETMA; 

MKFA; 

BCT  IOLP 


SUB  10. ,4 


STEP:DEC  N 

BEQ  ASTEP 
JMP  LOOP 

ASTEP: NOP 

CONVOL:  NOP 
NOP 


"END  MAIN  FILTER  LOOP 


"BEGIN  CONVOLVE 


LDSPI  COSFA;  DB-C0SFZ4MV 
LDSPI  SINFA;DB«SINFZ+MV 
"NORM  IS  READ  INTO  MA  10  EACH  TIME 
"START  CONVOLUTION  LOOP 
LDSPI  M;DB-MV 
LDSPI  N;DB-NV 
LDDPA ; 

DB-9. 


DB-ZERO; 

DPX<DB 

DPYOB 


LENA; 

PB-5 

• DB-ZERO; 

DPXOXDB 

MOV  H.ICNT 

LDSPI  JBI ; 
DB-MD 

LDDPA;DB-S 


LDDA; 

DB-5 

LDMA; 

DB-AZ 

MOP 

INCKA 

DPX(-2)<DB; 

DB-MD 

INCMA 

DPY(-3)<DB; 

DB-MD 

DPJ;(-3)<DB; 

DB-MD 

INCKA 

DPX(-3)<PB; 

DB-MD 

INCMA 

DPY(-4)<DB; 

DB-MD 

NOP 

DPX(-4)<DB; 

DB-MD 

LDMA; 

DB-6 


NOP 

NOP 

LDSPI  JPI; 
DB-MD 

I2LP:LDDPA;DB-5 

DB-ZERO; 

DPY(-2)<DB 

INC  JPI 
MOV  JFI.JWA 

INC  JBI 

LDSPI  JCNT; 
DB-5 

SUB  M.JUA 
LDTMA; 


"ZERO  TROW 
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DB-JTMA-l 


'SAVE  S FRONT  END  VALUES  IN  TM 


'GET  FIRST  J IK 


ADD  H, JRA;SETMA 


ADD  tl.JKA 
SETH  A 


'GET  SECOND  J IN 


J2LP:INCTMA 


OUT; 
DB-MD; 
DEC  JCNT 


ADD  M,JRA; 
SETMA; 
BCT  J2LP 


LDSPI  JCNT 
DB-4 


'READ  5 FROM  BACK  NO  WRITE 


MOV  JBI,JRA 
SETMA 


FMUL  DPX(-2),MD 


'A5*J 


FMUL  DPY (—3) ,MD 


'A4*J 


FMUL 


FMUL  »PX(-3)»MD; 
FADD  FM,DPY (3) 


’A3*J 

'(A5*J)+S10  (-J1) 


FMUL  DPY (-4) ,MD; 
FADD  FM,DPX(3) 


'A2*J 

'(A4*J)+S9  (-S10) 


FADD 


FADD  FM,DPX(2) 
DPY (3)<FA 


(A3*J)+S8  («S9) 
STO  SIO 


FMUL  DPX(-4),MD; 
FADD  FM  , DPY  ( 2 ) 


'A  1*J 

’(A2*J)+S7  (-S8) 


FMUL  DPY(-4),MD; 
FAOO  FM,DPX(l) 
DPX(3)<FA 


’A2*J 

’(Al*J)+S6  (-S7) 
'STO  S9 


FADD  DPY(l),MD; 
DPX(2)<FA; 

ADD  M, JRA; 

SETMA 

FMUL  DPY(-3),HD; 
FADD  FM,DPX(0); 
DPY(2)<FA 

FMUL  DPX(-2),MD; 
FADD  FM,DPY(0); 
DPX ( 1 ) <FA 

FMUL  DPX(-2),MD; 
FADD  FM.DPY(-l); 
DPY(l)<FA 


FMUL  DPY (-3) ,MD; 

FADD  FM.DPX(-l); 
DPX(0)<FA 

FMUL; FADD; 

DPX(-1  )<Ffl; 

DPY (0) <FA 

FMUL  DPX(-3),MD; 

FADD  FM.DPY (3) 

FMUL  DPY(-4),MD; 

FADD  FM,DPX(3) ; 
DPY(-1 )<FA 

FMUL  DPX (-4) ,MD;FADD 

FMUL; 

FADD  FM,DPX(2); 

DPY (3)<FA 

FMUL  DPX (-4), HD; 

FADD  FM.DPYC2); 

DEC  JCNT 

FMUL  DPY(-4),HD; 

FADD  FM,DPX(1); 
DPX(3)<FA; 

BCT  J3LP 

"READ  5 FROM  FRONT,  NO  WRITE 

LDSPI  JCNT; 

DB-5 

MOV  JFI.JRA 


J4I.P: FMUL  DPX (-3) ,MD; 

FADD  DPY ( 1 ) , MD ; 
DPX(2)<FA; 

ADD  M, JRA; 

SEYM  A 


"S 5+J  (-S6) 
”STO  S8 
"GET  NEXT  J 


"A4*J 

"(A1*J)+S4  (-S5) 
"STO  S7 

"A5*J  (-S1) 
"(A2*J)+S3  (-S4) 
“STO  S6 

"A5*J1 

“(A3*J)+S2  (-S3) 
"STO  S6 

"A4*J1 

"(A4*J)+S1  (-S2) 
"STO  S4 


"STO  SI 
"STO  S3 

"A3*J1 

"(A5*J1 )+S10  (-J) 
"A2*J 1 

"(A4*J )+S9  (-SIO) 
"STO  S2 

"Al*Jl 


"(A3*J1)+S8  (-S9) 
"STO  S10 

"AMJl 

"(A2*Jl)+S7  (-S8) 


"A2*J 1 

"(A1*J1)+S6  (-S7) 
"STO  S9 


FMUL  DPY(-3),MD; 

FA DD  FM.DPX(O); 
DPY(2)<FA 

FMUL  DPX(-2),HD; 

FADD  FM,DPY (0) ; 
DPX(i)<FA 

FMUL  DPX(-2),HD; 

FADD  FM.DPY(-l); 

DPY ( 1 ) <FA 

FMUL  DPY (-3) ,MD; 

FADD  FM.DPX(-l); 
DPX(0)<FA 

FMUL; FADD; 

DPX(-1)<FM; 

DPY(0)<FA 

FMUL  DPX(-3),MD; 

FADD  FM,DPY(3) 

FMUL  DPY (-4),MD; 

FADD  FM,DPX(3); 
DPY(-1)<FA 

FMUL  DPX(-4),MD;FADD 

FMUL; 

FADD  FM,DPX(2); 

DPY (3)<FA 

FMUL  DPX(-4),MD; 

FADD  FM,DPY(2); 

DEC  JCMT 

FMUL  DPY (-4) ,MD; 

FADD  FM.DPX(l); 
DPX(3)<FA; 

BCT  J4LP 

"READ  N-5  FROM  MIDDLE,  WITH  WRITE 

LDSPI  JCNT; 

DB-MV-5 


J5LP: FMUL  DPX(-3),MD; 

FADD  DPY(I),MD; 
DPX(2)<FA; 

ADD  M.JRA; 

SEIM  A 

FMUL  DPY(-3),MD; 
FADD  FM , DPX ( 0 ) ; 
DPY(2) <FA 

FMUL  DPX(-2),MD; 
FADD  FM.DPY (0) ; 
DPX(1)<FA 
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FMUL  DPX(-2) ,HD; 
FADO  FM,DPY(-l); 
DPY(1)<FA 

FMUL  DPY (-3) ,UD ; 
FADD  FM,DPX(-1 ) ; 
DPX(0)<FA 

FMUL; FADO; 
DPX(-1)<FM; 

DPY (0)<FA 

FMUL  DPX(-3) ,MD; 
FADD  FM.DPY (3) 

FMUL  DPY(-4),MD; 
FADD  FM,DPX(3); 
DPY (-1)<FA 

FMUL  0PX(-4) ,MD 
FADD  DPY(-2),FA; 
ADD  H.JUA; 

SETMA; 

MI<FA 

FMUL; 

FADD  FM,DPX(2); 
DPY(3)<FA 

FMUL  DPX (-4 ) , MD ; 

FADD  FM,DPY (2) ; 
DPY(-2)<FA; 

DEC  JCNT 

FMUL  DPY(-4),MD; 
FADD  FM,DPX(1 ) ; 
DPX(3)<FA; 

BCT  J5LP 

"READ  5 FROM  TM  STORE, WRITE 

LDTMA ; 

DB-JTMA-1 
LDSPI  JCNT;DB-5 


J6LP: FMUL  DPX(-3),!1D; 

FADD  DPY(1 ) ,MD ; 
DPX(2)<FA; 

IKCTMA 

FMUL  DPY(-3),!fl»; 
FADD  FM,DPX(0) ; 
DPY(2)<FA 

FMUL  DPX (-2) ,MD ; 
FADD  FH,DPY(0) ; 
DPX(1 )<FA 

FMUL  TM,DPX(-2) ; 
FADD  FM.DPY(-l); 
DPY ( 1 )<FA 


r 


FMUL  TM,DPY(-3); 
FADD  FM,DPX(-1); 
DPX(0)<FA 

FMUL; FADD; 
DPX(-1)<FM; 
DPY(OXFA 

FMUL  TM,DPX(-3); 
FADD  FM,DPY(3) 

FMUL  TM.DPY (-4) ; 
FADD  FM,DPX(3); 
DPY(-1)<FA 

FMUL  TM,DPX(-4); 
FADD  DPY(-2),FA; 
ADD  M.JWA; 

SETMA; 

MXFA 

FMUL; 

FADD  FM,DPX(2); 
DPY(3)<FA 

FMUL  TM,DPX(-4); 

FADD  FM,DPY(2); 
DPY(-2)<FA; 

DEC  JCNT 

FMIIL  TM,DPY(-4); 
FADD  FM.DPX(l); 
DPX(3) <FA; 

BGT  J6LP 

"FINISH  ROW  OPERATIONS 


SUB#  ICNT.COSFA; 
SETMA 


L 


LDDPA; 

DB-7 

SUB#  ICNT.SINFA; 
SETMA 

FMUL  DPY (-4) ,MD 

FADD  DPX(3),DPY(-4) ; 
FMUL 

FMUL  DPY (-4) ,MD; 

FADD 

FADD  FM,DPY(2); 
DPX(3)<FA; 

FMUL 

FADD; 

FMUL 

FADD  FM,DPX(2); 

DPY (2) <FA 


118 


FADD 


$TITLE  EXPDO 
$ENTRY  EXPDO 

$EXT  NEXTMD  "IN  RLNLF  - RETURNS  AD DR  IN  MD 
"<SN1>  EXP(Z1*<S1>+Z2*<S2>) 

"VERSION  1-25-78 
"NEW  SPAD-TM 
"MV. 

"+SP4  s-1 
"RMOVE  SPFTMA 

$EXT  VSMUL, VADD, VEXP  "LINK  FROM  APLIB.FRB 
MV  - 16. 

SN1Z  - 20. 

"MD  ADDRESSES  (RELATIVE  TO  NEXTMD) 

S1Z  - 0. 

S2Z  - S1Z-MV 
INBUF  - S2Z+MV 
Z1Z  - INBUF 
Z2Z  - Z1Z+1 

TIZ  - Z2Z+1 

T2Z  - T1Z+MV 

"NEXT  FREE  - T2Z+MV 

STMADR  - 10500K  "START  SAVE  AD DR  IN  TM  FOR  SPAD 

EXPDO:  NOP 

MOV  0,0;  DPX<SPFN 
LDSPI  0;DB-0. 

MOV  0,0;SETMA;  MKDPX  "MD(0):-ItIITSW 
NOP 

JSR  NEXTMD 
LDSPI  1 ; DB-l 
LDSPI  2;DB-Z1Z 

ADD  0,2  "GET  ABSOLUTE  ADDR 

LDSPI  3;  DB-T1Z 

ADD  0,3 

LDSPI  4;  DB-l 

LDSPI  5;  DB-MV 

JSR  VSMUL  "<T1>  - <S1>*ZI 

JSR  NEXTMD 
LDSPI  1 ;DB-1 
LDSPI  2;  DB-Z2Z 
ADD  0,2 

LDSPI  3;  DB-T2Z 
ADD  0,3 
LDSPI  4;  DB-l 
LDSPI  5;  DB-MV 
LDSPI  A.DB-S2Z 
ADD  0,6 
MOV  6,0 

JSR  VSMUL  "<T2>  - <S2>*Z2 
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JSR  NEXTMD 
LDSPI  1;DB-1 
LDSPI  2;  DB-T2Z 
A DO  0,2 
LOSPI  3;  DB-1 
LDSPI  4;  DB-SN1Z 
LDSPI  5;  DB-I 
LDSPI  6;  DB-MV 
LDSPI  7;D3-T1Z 
ADD  0,7 
MOV  7,0 

JSR  VADD  "<SN1>  - <T1>-KT2> 


LDSPI  0;  DB-SN1Z 
LDSPI  1;DB-1 
LDSPI  2;  DB-SN1Z 
LDSPI  3;  DB-1 
LDSPI  4;  D3-MV 
JSR  VEXP 


<SN1>  - EXP(<SN1>) 


LDMA;  DB-O.  "RESTORE  INITSW  FROM  MD(O) 

NOP 

NOP 

NOP 

LDSPI  0;DB-MD 

NOP 

RETURN 


DEFINE  ME  (AAHEU  ,AAOLD,ASC  l ,AADLT, ASC2 ,ASC3 , ACA,AXP2  ,ACLF  ,AHOKM) 

LOCAL  K,KM,B,D 

K-16 

KM-240 

B-AAOLD+1 5 

LOOP: CALL  VFILL(3,ASCl, 1, 16) 

CALL  VSMUL(ASC1, l,ACA,ASC2, I, 16) 

CALL  VFILL(AADLT,ASC3,1,L6) 

CALL  VADD(ASC3,1,ASC2,1, ASCI, 1,16) 

CALL  VADD(ASCl, 1, AANEU, 1.ASC2, 1,16) 

CALL  VSQ (ASC 2, 1 , ASC l ,1,16) 

CALL  VSMUL(ASC I , 1 ,AXP2 , ASC2 , 1,16) 

CALL  VEXP(ASC2, 1 , ASC 3, 1,16) 

D-ACLF+KM 

CALL  VSMUL(ASC3, l ,ANORM ,0,1,16) 

B-B-l 

KM-KM-16 

K-K-l 

IF  K>0  GOTO  LOOP 
END 


$TITLE  TTMOV 
$ ENTRY  TTMOV.3 
A $EQU  0 
C $EQU  1 
N $EOU  2 

TTMOV : MOV  A,A;SETMA 
DEC  C;SETTMA 
INCHA 
LDDA; 

D8-5 

LOOP: INCMA; 

DPX<MD; 

DEC  N 

OUT;DB-DPX;IKCTMA; 

BME  LOOP 

RETURN 

$END 
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"W.FSO 
$TITLE  W 
$ ENTRY  U,0 
$EXT  STHIRD 
"S  PAD  ADDRESSES 
B $EQU  0 
1 $EQU  8. 

J $EQU  9. 

NJ  $EQU  10. 
U:LDSPI  I; 

DB-96. 
LDSPI  II J; 
DB-1908. 


LOOPIsLDSPI  J;DB-16 
LOOPJ:MOV  NJ  »B 


JSK  STHIRD 


BCT  LOOPJ 


BGT  LOOP I 


RETURN 


••STIIIRD.FSO 
$TITLE  STHIRD 
$ ENTRY  STHIRD , 1 

"SIZING 
MV  $EQU  16. 

NV  $EQU  96. 

MN1V  $EQU  MV*NV+MV 
"TABLE  MEMORY  ADDRESSES 
ISTAT  $EQU  11000 
"S  PAD  ADDRESSES 

ITOPS  $EQU  0 
M $EQU  1 
MN1  $EQU  2 
KBIAS  $EQU  3 
MKK  $EQU  4 
UK  $EQU  5 
TMINC  $EQlf  6 
STHIRD :LDSPI  KBIAS; 

D3-0 

LDSPI  M; 

DB-MV 

LDSPI  MX; 

DB-MV 
LDSPI  MN1 ; 

DB-MNIV 

LDSPI  TMINC; 

DB -ISTAT 

LDTMA; 

DB-1ZERO 

LDDPA; 

DB-0 

D?X (0)<TM; 

DPY(0)<TM; 

DEC  MX 

LPDPXY : DPX (0) <TM ; 

DPY (0)<TM; 

DEC  MK; 

INCDPA; 

BCT  LPDPXY 

LDSPI  MIC; 

DB-MV 

LPTMA ; 

DB-ISTAT 

LOOP  K : AD  D ,'i  I TOPS  .KBIAS; 

SETMA 

LDSPI  MKK; 

DB-HV-B. 
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DB-31. 

INCTMA 

FMUL  TM,MD;INCTMA 

FMUL  TM.MD; 

INCTMA 


FMUL  TM.MD ; 
INCTMA; 

INCDPA 

FMUL  TM.HD; 
INCTMA; 

INCDPA; 

FADD  FM.DPX(O) 

FMUL  TM.HD; 
INCTMA; 

INCDPA; 

FADD  FM.DPX(O) 

FMUL  TM.MD; 
INCTMA; 

INCDPA; 

FADD  FH.DPX(O); 
DPX(-2)<FA 

FMUL  TM.MD; 
INCTMA; 

INCDPA; 

FADD  FM.DPX(O); 
DPX(-2)<FA; 

DEC  MKK 

LOOPXK: FMUL  TM.MD; 

INCTMA; 

INCDPA; 

FADD  FM.DPX(O); 
DPX(-2)<FA; 

DEC  MKK; 

BCT  LOOPKK 

FMUL  TM.MD; 
INCDPA; 

FADD  FM.DPX(O) ; 
DPX(-2)<FA 

FMUL; 

INCDPA; 

FADD  FM.DPX(O) ; 
DPX(— 2)<FA 

FMUL; 

INCDPA; 

FADD  I'M.DP'C (0) ; 
DPX(-2)<FA 

INCDPA; 

FADD  FM.DPa(O) ; 
DPX (-2) <FA 


FADD; 

DPX(-2)<FA 

INCDPA; 

UPX(-2)<FA; 
DEC  MK 

ADD  MN1 ,K3IAS; 
BEQ  STEP 
JMP  LOOPK 

STEPrLDDPA; 

DB-0 

LDSPI  MK; 

DB-MV 

SUB  MNl.ITOPS 

LOO PR: INCOPA; 

DEC  MK 

ADD  MNI , ITOPS; 
SETMA; 
MKDPX(-l); 
BGT  LOOPS 

NO? 

RETURN 

$END 


| ! 
It 


i : 


DEFINE  XSUM(ITOPS,M,AXJ,KBIAS) 

LOCAL  K,A,B 

K-16 

LOOP : K-K-l 

A-ITOPS+K 

B-AXJ+K 

CALL  SVE(A,H,B,KBIAS) 

IF  K>0  COTO  LOOP 
END 


DEFINE  ZSUM(ITOPS,H,AZJ,KBIAS) 

LOCAL  K,A,B,L,C 

K-16 

L-KBIAS-H 
C-15*KBIAS 
A-ITOPS+C 
LOOP: K-K-l 
B-AZJ+K 

CALL  SVE(A,1,B,L) 

A-A-KRIAS 
IF  K>0  COTO  LOO? 

END 
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